103 lines
2.8 KiB
Plaintext
103 lines
2.8 KiB
Plaintext
' ReplacePseudoSerialNumbers()
|
|
' ----------------------------------------------------------------------------
|
|
' Ersetzt die Pseudo-Seriennummer durch die konkrete Seriennummer
|
|
' Betroffen sind neben der Artikeltabelle (t024) folgende Tabellen
|
|
' - Artikelmatch (t027)
|
|
' - Statistik (t039)
|
|
' - Lagerbuchungsjournal (t083)
|
|
'
|
|
' Returns: -
|
|
' ----------------------------------------------------------------------------
|
|
' Copyright (c) 2021 by Digital Data GmbH
|
|
'
|
|
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
|
|
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
|
|
' ----------------------------------------------------------------------------
|
|
' Creation Date / Author: 22.02.2022 / MP
|
|
' Version Date / Editor: 01.05.2023 / MP/JJ
|
|
' Version Number: 4.1.0.0
|
|
|
|
|
|
Function ReplacePseudoSerialNumbers(AuftragsNr, QueryStatus)
|
|
Set Conn = CWLStart.Connection
|
|
Err.Clear
|
|
|
|
'-------------- UPDATE
|
|
|
|
Dim RechnerName : RechnerName = GetWindowsEnvironment("COMPUTERNAME")
|
|
Dim ReplaceSQL : ReplaceSQL = ""
|
|
ReplaceSQL = ReplaceSQL & "SET SHOWPLAN_ALL OFF; SET NOCOUNT ON; SET ARITHABORT ON; "
|
|
ReplaceSQL = ReplaceSQL & "EXEC UPDATE_ARTICLE_PSEUDO_SERIALNUMBER "
|
|
ReplaceSQL = ReplaceSQL & "'" & AuftragsNr & "', "
|
|
ReplaceSQL = ReplaceSQL & "'" & RechnerName & "', "
|
|
ReplaceSQL = ReplaceSQL & "'" & QueryStatus & "', "
|
|
ReplaceSQL = ReplaceSQL & "'" & MandatorNr & "', "
|
|
ReplaceSQL = ReplaceSQL & "'" & WinLineCurrentYear & "'; "
|
|
ReplaceSQL = ReplaceSQL & "SET NOCOUNT OFF;"
|
|
|
|
If DEBUG_ON = True Then
|
|
AddDebugLine "Executing UPDATE_ARTICLE_PSEUDO_SERIALNUMBER"
|
|
AddDebugLine "SQL: " & ReplaceSQL
|
|
ShowDebugBox "ReplacePseudoSerialNumbers"
|
|
End If
|
|
|
|
Result = Conn.ExecuteSQL(ReplaceSQL)
|
|
|
|
If DEBUG_ON = True Then
|
|
AddDebugLine "Response from Procedure:"
|
|
AddDebugLine "Result: " & Result
|
|
|
|
ShowDebugBox "ReplacePseudoSerialNumbers"
|
|
End If
|
|
|
|
If Result = False Then
|
|
ReplacePseudoSerialNumbers = False
|
|
Exit Function
|
|
End If
|
|
|
|
'--------------SELECT
|
|
|
|
Dim SelectSQL : SelectSQL = ""
|
|
SelectSQL = SelectSQL & "SELECT TOP 1 [Status] c000 FROM dbo.TBDD_PACKTISCH_HISTORY (NOLOCK) "
|
|
SelectSQL = SelectSQL & "WHERE Rechnername = '" & RechnerName & "' "
|
|
SelectSQL = SelectSQL & "AND Status = 'Error' "
|
|
SelectSQL = SelectSQL & "AND AuftragsNr = '" & AuftragsNr & "' "
|
|
SelectSQL = SelectSQL & SQLQuery_BasicWhere
|
|
|
|
Result = Conn.Select(SelectSQL)
|
|
|
|
If Result < 0 Then
|
|
If Err <> 0 Then
|
|
MsgBox "Fehler bei Abfrage: " & vbNewline & SelectSQL & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - ReplacePseudoSerialNumbers"
|
|
ReplacePseudoSerialNumbers = False
|
|
Else
|
|
' Alles OK, keine Error Zeilen
|
|
ReplacePseudoSerialNumbers = True
|
|
End If
|
|
Else
|
|
' Es wurden Zeilen mit Status 'Error' gefunden
|
|
ReplacePseudoSerialNumbers = False
|
|
End If
|
|
End Function
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|