AppStd/Skriptentwickung
8
0
Fork 0
Code Activity

Module: Reorg / Cleanup

Browse Source
This commit is contained in:
KammM
2024-11-08 15:39:19 +01:00
parent 36ef16eb34
commit 294debc67c
226 changed files with 436 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
archive/Modules/Sicherungen/Modules_20230623/AddDebugLine.vbs Normal file
View File

@@ -0,0 +1,18 @@
' AddDebugLine(Message: String)
' ----------------------------------------------------------------------------
' Fügt der DEBUG_MESSAGE eine neue Zeile hinzu
'
' 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: 20.08.2020 / XX
' Version Date / Editor: 20.08.2020 / XX
' Version Number: 1.0.0.0
Sub AddDebugLine(Message)
DEBUG_MESSAGE = DEBUG_MESSAGE & Message & vbNewLine
End Sub

19
archive/Modules/Sicherungen/Modules_20230623/AddTwoDimArrayRow.vbm Normal file
View File

@@ -0,0 +1,19 @@
' AddTwoDimArrayRow(arr: Array)
' ----------------------------------------------------------------------------
' Fügt an ein zweidimensionales Array eine Zeile an.
' Wichtig: Die Spalten müssen die erste Dimension sein!
'
' 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: 18.02.2021 / JJ
' Version Date / Editor: 18.02.2021 / JJ
' Version Number: 3.0.0.0
Sub AddTwoDimArrayRow(Byref arr)
ReDim Preserve arr(UBound(arr, 1), UBound(arr, 2) + 1)
End Sub

49
archive/Modules/Sicherungen/Modules_20230623/ConvertFromSecureString.vbs Normal file
View File

@@ -0,0 +1,49 @@
' ConvertFromSecureString(Ciphertext : String)
' ----------------------------------------------------------------------------
' Gibt den entschlüsselten String zurück
'
' Source: https://gist.github.com/albert1205/c8430b5bfa505f9308e4fa789b9b1d7f
'
' Returns: ConvertFromSecureString : String
' ----------------------------------------------------------------------------
' 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: 26.08.2020 / XX
' Version Date / Editor: 26.08.2020 / XX
' Version Number: 1.0.0.0
Public Function ConvertFromSecureString(Ciphertext)
Const offset = 10
Const minAsc = 33
Const maxAsc = 126
If Len(Ciphertext) < 5 Then
Decrypt = ""
Exit Function
End If
Dim Plaintext
Ciphertext = Mid(Ciphertext,3,Len(Ciphertext)-4)
For i=2 To Len(Ciphertext) Step 2
oldAsc = Asc(Mid(Ciphertext,i,1)) + offset
If oldAsc > maxAsc Then
oldAsc = oldAsc - maxAsc + minAsc - 1
End If
Plaintext = Plaintext & Chr(oldAsc)
' MsgBox Asc(Mid(Ciphertext,i,1)) & " -> " & oldAsc
Next
ConvertFromSecureString = Plaintext
End Function
Private Sub DecryptTool()
Ciphertext = InputBox("Bitte den zu entschluesselnden String eingeben:", "Eingabe erfolderlich","")
Plaintext = ConvertFromSecureString(Ciphertext)
InputBox "Ihre Eingabe lautete: " & Ciphertext & vbNewLine & vbNewLine & "Entschluesselt, sieht der String wie folgt aus:","Erledigt!",Plaintext
End Sub

55
archive/Modules/Sicherungen/Modules_20230623/ConvertToSecureString.vbs Normal file
View File

@@ -0,0 +1,55 @@
' ConvertToSecureString(Plaintext : String)
' ----------------------------------------------------------------------------
' Verschlüsselt einen String
'
' Source: https://gist.github.com/albert1205/c8430b5bfa505f9308e4fa789b9b1d7f
'
' Returns: ConvertToSecureString : String
' ----------------------------------------------------------------------------
' 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: 26.08.2020 / XX
' Version Date / Editor: 26.08.2020 / XX
' Version Number: 1.0.0.0
Public Function ConvertToSecureString(Plaintext)
Const offset = 10
Const minAsc = 33
Const maxAsc = 126
Dim Ciphertext
Randomize
Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
For i=1 To Len(Plaintext)*2
If i mod 2 = 0 Then
newAsc = Asc(Mid(Plaintext,i/2,1)) - offset
If newAsc < minAsc Then
newAsc = newAsc + maxAsc - minAsc + 1
End If
Ciphertext = Ciphertext & Chr(newAsc)
' MsgBox Asc(Mid(Plaintext,i/2,1)) & " -> " & newAsc
Else
Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
' MsgBox "Rnd:" & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
End If
Next
Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
ConvertToSecureString = Ciphertext
End Function
Private Sub EncryptTool()
Plaintext = InputBox("Bitte den zu verschluesselnden String eingeben:","Eingabe erfolderlich","")
Ciphertext = ConvertToSecureString(Plaintext)
InputBox "Ihre Eingabe lautete: " & Plaintext & vbNewLine & vbNewLine & "Verschluesselt, sieht der String wie folgt aus:","Erledigt!",Ciphertext
End Sub
Call EncryptTool

68
archive/Modules/Sicherungen/Modules_20230623/CreateDateDirectory.vbm Normal file
View File

@@ -0,0 +1,68 @@
' ArticleExists(Identifier: String)
' ----------------------------------------------------------------------------
' Findet Artikelnummer anhand von versch. Kriterien
' - Artikel-Nummer, Alternative Artikel-Nummer, EAN-Code, Seriennummer
' - Gibt die Zeile im Grid zurück in der Artikel das erste Mal gefunden wurde
'
' Returns: ArticleExists: Int
' ----------------------------------------------------------------------------
' 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: 02.02.2022 / JJ/MP
' Version Date / Editor: 22.03.2022 / JJ/MP
' Version Number: 1.0.0.0
Function CreateDateDirectory(BasePath)
Set oFileSys = CreateObject("Scripting.FileSystemObject")
NowDate = Date
NowYear = Year(NowDate)
NowMonth = PadZero(Month(NowDate))
NowDay = PadZero(Day(NowDate))
If Right(BasePath, 1) <> "\" Then
BasePath = BasePath & "\"
End If
YearPath = BasePath & NowYear & "\"
MonthPath = YearPath & NowMonth & "\"
DayPath = MonthPath & NowDay
If Not oFileSys.FolderExists(YearPath) Then
oFileSys.CreateFolder(YearPath)
End If
If Not oFileSys.FolderExists(MonthPath) Then
oFileSys.CreateFolder(MonthPath)
End If
If Not oFileSys.FolderExists(DayPath) Then
oFileSys.CreateFolder(DayPath)
End If
CreateDateDirectory = DayPath
End Function
Function PadZero(Num)
If Len(Num) = 1 Then
PadZero = "0" & Num
Else
PadZero = Num
End If
End Function
Function GetRelativDateDirectoryName()
GetRelativDateDirectoryName = ""
NowDate = Date
NowYear = Year(NowDate)
NowMonth = PadZero(Month(NowDate))
NowDay = PadZero(Day(NowDate))
GetRelativDateDirectoryName = NowYear & "\" & NowMonth & "\" & NowDay
End Function

18
archive/Modules/Sicherungen/Modules_20230623/GetLeftPad.vbs Normal file
View File

@@ -0,0 +1,18 @@
' GetLeftPad(Value)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: GetLeftPad : String
' ----------------------------------------------------------------------------
' 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: 10.08.2020 / MK
' Version Date / Editor: 10.08.2020 / MK
' Version Number: 1.0.0.0
Function GetLeftPad(Value)
GetLeftPad = Right("0" & Value, 2)
End Function

80
archive/Modules/Sicherungen/Modules_20230623/GetWinLineDocDeliveryNoteByUnsplittedProducts.vbs Normal file
View File

@@ -0,0 +1,80 @@
' GetWinLineDocDeliveryNoteByUnsplittedProducts(ProductNumber : String, WinLineMandatorNr : String, WinLineYear : Int)
' ----------------------------------------------------------------------------
' Dieses Modul fndet die Eingangsbelege zu einer ProductNumber
'
' Returns: SQL-Results
' ----------------------------------------------------------------------------
' 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: 15.09.2020 / JJ
' Version Date / Editor: 05.10.2021 / MP/JJ
' Version Number: 3.0.0.6
Function GetWinLineDocDeliveryNoteByUnsplittedProducts(ProductNumber, WinLineMandatorNr, WinLineYear)
Dim Conn, Result
Set Conn = CWLStart.CurrentCompany.Connection
If (ProductNumber <> "") and (WinLineMandatorNr <> "") and (WinLineYear <> "") Then
'c999 = DeliveryNr
'c998 = InvoiceNr
'c997 = KeyValue
'c996 = KeyValue
'MESOPRIM = MESOPRIM
'c995 = Amount / Pos
'c994 = Amount / overall
SQL = ""
SQL = SQL & "SELECT t025.c045 as [c999], t025.c055 as [c998], T026.C000 as [c997], T025.C000 as [c996], T024.MESOPRIM, t026.c006 as [c995], "
SQL = SQL & "( "
SQL = SQL & "SELECT sum(t026.c006) "
SQL = SQL & "FROM T026 WITH (NOLOCK), T025 WITH (NOLOCK), T024 WITH (NOLOCK) "
SQL = SQL & "WHERE T026.MESOCOMP = '"& WinLineMandatorNr &"' AND T025.MESOCOMP = '"& WinLineMandatorNr &"' AND T024.MESOYEAR = '"& WinLineCurrentYear &"' AND T024.MESOCOMP = '"& WinLineMandatorNr &"' "
SQL = SQL & "AND (T025.C021 = T026.C044 AND T025.C022 = T026.C045 AND T025.C137 = 3 AND T026.C042 = N'1' AND T026.C055 < 10 AND T026.C074 < 10 AND T025.C186 = 0 AND T026.C003 = T024.C002 "
SQL = SQL & "AND (T025.C025 = N'D' OR T025.C025 =N'*' OR T025.C026 = N'D' OR T025.C026 =N'*') "
SQL = SQL & "AND (T026.C039 = N'D' OR T026.C039 =N'*' OR T026.C040 = N'D' OR T026.C040 =N'*') "
SQL = SQL & "AND T026.C006 <> 0.0 AND T026.C109 <= 0 AND T026.C003 >= '"& ProductNumber &"' AND T026.C003 <= '"& ProductNumber &"') "
SQL = SQL & ") as [c994] " ' Summe aller gefundenen gelieferten Mengen
SQL = SQL & "FROM T026 WITH (NOLOCK), T025 WITH (NOLOCK), T024 WITH (NOLOCK) "
SQL = SQL & "WHERE T026.MESOCOMP = '"& WinLineMandatorNr &"' AND T025.MESOCOMP = '"& WinLineMandatorNr &"' AND T024.MESOYEAR = '"& WinLineCurrentYear &"' AND T024.MESOCOMP = '"& WinLineMandatorNr &"' "
SQL = SQL & "AND (T025.C021 = T026.C044 AND T025.C022 = T026.C045 AND T025.C137 = 3 AND T026.C042 = N'1' AND T026.C055 < 10 AND T026.C074 < 10 AND T025.C186 = 0 AND T026.C003 = T024.C002 "
SQL = SQL & "AND (T025.C025 = N'D' OR T025.C025 =N'*' OR T025.C026 = N'D' OR T025.C026 =N'*') "
SQL = SQL & "AND (T026.C039 = N'D' OR T026.C039 =N'*' OR T026.C040 = N'D' OR T026.C040 =N'*') "
SQL = SQL & "AND T026.C006 <> 0.0 AND T026.C109 <= 0 AND T026.C003 >= '"& ProductNumber &"' AND T026.C003 <= '"& ProductNumber &"' ) "
SQL = SQL & "ORDER BY T026.C003 ASC, T026.C025, T026.C044, T026.C045 "
Set Result = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Querying for unsplitted delivery notes.. " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL (Part 1): " & Mid(SQL, 1, 750)
AddDebugLine "SQL (Part 2): " & Mid(SQL, 750)
ShowDebugBox "GetWinLineInternalProductNumber"
End If
'Use the set order, because we want to return an object!
Set GetWinLineDocDeliveryNoteByUnsplittedProducts = Result
Else
If DEBUG_ON = True Then
AddDebugLine "Invalid argument call!" & vbNewline
ShowDebugBox "GetWinLineInternalProductNumber"
End If
GetWinLineDocDeliveryNoteByUnsplittedProducts = 0
End If
End Function

281
archive/Modules/Sicherungen/Modules_20230623/GetWinLineDocInfoByAccountAndRunningNr.vbs Normal file
View File

@@ -0,0 +1,281 @@
' GetWinLineDocInfoByAccountAndRunningNr(DocAccountAndRunningNr : String, PostingType : String, WinLineDocType : String)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: GetWinLineDocInfoByAccountAndRunningNr : String
' ----------------------------------------------------------------------------
' 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: 08.01.2021 / XX
' Version Date / Editor: 08.01.2021 / XX
' Version Number: 1.0.0.0
Function GetWinLineDocInfoByAccountAndRunningNr(DocAccountAndRunningNr, PostingType, WinLineDocType)
On Error Resume Next
'Set SQL Table and Query for DocHead. Default: "T025"
SQLTable_DocHead = "[T025]"
SQLQuery_DocHead = "c000 = '" & DocAccountAndRunningNr & "'" & SQLQuery_OrderWhere
'Set SQL Table and Query for DocMid. Default: "T026"
SQLTable_DocMid = "[T026]"
SQLQuery_DocMid_MengeGeliefert = ""
SQLQuery_DocMid_MengeGeliefert = SQLQuery_DocMid_MengeGeliefert & "SELECT SUM(c006) as [MengeGeliefert] "
SQLQuery_DocMid_MengeGeliefert = SQLQuery_DocMid_MengeGeliefert & "FROM " & SQLTable_DocMid & "(NOLOCK) "
SQLQuery_DocMid_MengeGeliefert = SQLQuery_DocMid_MengeGeliefert & "WHERE [c000] LIKE '" & DocAccountAndRunningNr & "-%'" & SQLQuery_OrderWhere
SQLQuery_DocMid_Rueckstandsmenge = ""
SQLQuery_DocMid_Rueckstandsmenge = SQLQuery_DocMid_Rueckstandsmenge & "SELECT SUM(c099) as [RueckstandsMenge] "
SQLQuery_DocMid_Rueckstandsmenge = SQLQuery_DocMid_Rueckstandsmenge & "FROM " & SQLTable_DocMid & "(NOLOCK) "
SQLQuery_DocMid_Rueckstandsmenge = SQLQuery_DocMid_Rueckstandsmenge & "WHERE [c000] LIKE '" & DocAccountAndRunningNr & "-%'" & SQLQuery_OrderWhere
IF (SQLTable_DocHead <> "") and (SQLQuery_DocHead <> "") and (PostingType <> "") and (WinLineDocType <> "") Then
Set SQLResult_DocHead = CWLStart.CurrentCompany.SearchRecord (SQLTable_DocHead, SQLQuery_DocHead)
If Err.Number <> 0 Then
MSGBOX "Error Code: "& Err.Number & vbCrlf & _
"Error Description: "& Err.Description,,"ERROR: Function GetWinLineDocInfoByAccountAndRunningNr Getting DocHead from DB Table "& SQLTable_DocHead
Err.Clear
Else
'If no line results
If SQLResult_DocHead.RowCount = -1 Then
If DebugMode = "Enabled" Then
MSGBOX "No Rows found, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNrDocHead from Database table "& SQLTable_DocHead
End If
Elseif SQLResult_DocHead.RowCount = 1 Then
If DebugMode = "Enabled" Then
MSGBOX "One Row found, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNrDocHead from Database table "& SQLTable_DocHead
End If
'Unique Key
DocAccountAndRunningNr = SQLResult_DocHead.value(0)
'Laufnumemr
DocRunningNr = SQLResult_DocHead.value(21)
'Druckstatus Angebot / Anfrage
DocPrintState1 = SQLResult_DocHead.value(22)
'Druckstatus Auftrag / Bestellung
DocPrintState2 = SQLResult_DocHead.value(23)
'Druckstatus Lieferschein
DocPrintState3 = SQLResult_DocHead.value(24)
'Druckstatus Rechnung
DocPrintState4 = SQLResult_DocHead.value(25)
'Number of the Offer ("Angebot")
DocOfferNr = SQLResult_DocHead.value(41)
'Number of the Order ("Angebot")
DocOrderNr = SQLResult_DocHead.value(42)
'Number of delivery note ("Lieferschein")
DocDeliveryNoteNr = SQLResult_DocHead.value(43)
'Number of the Invoice ("Rechung")
DocInvoiceNr = SQLResult_DocHead.value(52)
'When the doc ("Beleg") was created
DocCreated = SQLResult_DocHead.value(56)
'When the doc ("Beleg") was last changed
DocLastChange = SQLResult_DocHead.value(57)
'The ten "Belegkopfnotizen"
DocHeadText1 = SQLResult_DocHead.value(59)
DocHeadText2 = SQLResult_DocHead.value(60)
DocHeadText3 = SQLResult_DocHead.value(61)
DocHeadText4 = SQLResult_DocHead.value(62)
DocHeadText5 = SQLResult_DocHead.value(63)
DocHeadText6 = SQLResult_DocHead.value(64)
DocHeadText7 = SQLResult_DocHead.value(65)
DocHeadText8 = SQLResult_DocHead.value(66)
DocHeadText9 = SQLResult_DocHead.value(67)
DocHeadText10 = SQLResult_DocHead.value(68)
'The current type (1= Anfrage/Angebot; 2= Auftrag/Bestellung; 3= Lieferschein; 4=Rechnung)
DocType = SQLResult_DocHead.value(134)
DocComment = SQLResult_DocHead.value(163)
'msgbox SQLQuery_DocMid_MengeGeliefert
'msgbox SQLQuery_DocMid_RueckstandsMenge
Set SQLResult_DocMid_MengeGeliefert = CWLStart.CurrentCompany.Connection.Select(SQLQuery_DocMid_MengeGeliefert)
'msgbox SQLResult_DocMid_MengeGeliefert.value("MengeGeliefert")
Set SQLResult_DocMid_RueckstandsMenge = CWLStart.CurrentCompany.Connection.Select(SQLQuery_DocMid_RueckstandsMenge)
'msgbox SQLResult_DocMid_RueckstandsMenge.value("RueckstandsMenge")
IF DebugMode = "Enabled" THEN
End if
DocBackOrder = SQLResult_DocMid_RueckstandsMenge.value("RueckstandsMenge")
'msgbox SQLResult_DocMid_Rueckstandsmenge.value("RueckstandsMenge")
IF (PostingType = 1) Then
'If doc = "Angebot" or "Angebots-storno"
IF (WinLineDocType = 1) or (WinLineDocType = 11) then
DocNr = DocOfferNr
IF (WinLineDocType = 1) then
WinLineDocType = "Angebot (debitorisch)"
ElseIF (WinLineDocType = 11) then
WinLineDocType = "Angebot-Storno (debitorisch)"
End If
'If doc = "Auftrag" or "Auftrag-storno"
ElseIf (WinLineDocType = 2) or (WinLineDocType = 12) then
DocNr = DocOrderNr
IF (WinLineDocType = 2) then
WinLineDocType = "Auftrag (debitorisch)"
ElseIF (WinLineDocType = 12) then
WinLineDocType = "Auftrag-Storno (debitorisch)"
End If
'If doc = "Lieferschein" or "Lieferschein-storno" or "Teillieferschein"
ElseIf (WinLineDocType = 3) or (WinLineDocType = 13) or (WinLineDocType = -3) then
DocNr = DocDeliveryNoteNr
IF (DocBackOrder = 0) and (DocPrintState3 <> "L") then
WinLineDocType = "Lieferschein (debitorisch)"
ElseIF (DocBackOrder = 0) and (DocPrintState3 = "L") then
WinLineDocType = "Lieferschein-Storno (debitorisch)"
ElseIF (DocBackOrder <> 0) and (DocPrintState3 <> "L") then
WinLineDocType = "Teillieferschein (debitorisch)"
ElseIF (DocBackOrder <> 0) and (DocPrintState3 = "L") then
'Über die DB Werte ist eine Unterscheidung zwischen Lieferschein und Teillieferschein Storno nicht möglich!
WinLineDocType = "Teillieferschein-Storno (debitorisch)"
End If
'If doc = "Rechnung" or "Rechnungs-storno"
ElseIf (WinLineDocType = 4) or (WinLineDocType = 14) then
DocNr = DocInvoiceNr
IF (WinLineDocType = 4) and (DocPrintState4 <> "L") then
WinLineDocType = "Rechnung (debitorisch)"
ElseIF (WinLineDocType = 4) and (DocPrintState4 = "L") then
WinLineDocType = "Rechnung-Storno (debitorisch)"
ElseIF (WinLineDocType = 14) and (DocPrintState4 = "L") then
WinLineDocType = "Rechnung-Storno (debitorisch)"
End If
Else
IF DebugMode = "Enabled" THEN
MSGBOX "WinLineDocType is not configured!" & vbCrLf & _
"WinLineDocType: " & WinLineDocType, , "DEBUG - Info: Export Metadata"
END IF
End if
ElseIf (PostingType = 2) Then
'not implement
End if
'Array for the function to return
DIM DocInfo(250)
'Items like T25 c000 to c188
DocInfo(59) = DocCreated
DocInfo(60) = DocLastChange
DocInfo(63) = DocHeadText1
DocInfo(64) = DocHeadText2
DocInfo(65) = DocHeadText3
DocInfo(66) = DocHeadText4
DocInfo(67) = DocHeadText5
DocInfo(68) = DocHeadText6
DocInfo(69) = DocHeadText7
DocInfo(70) = DocHeadText8
DocInfo(71) = DocHeadText9
DocInfo(72) = DocHeadText10
DocInfo(139) = DocType
DocInfo(165) = DocComment
'Items beyond T25
DocInfo(200) = WinLineDocType
DocInfo(201) = DocNr
IF DebugMode = "Enabled" THEN
CRLF = chr(13)&chr(10)
msg = "Parameter:" & CRLF
For i = 0 To Ubound(DocInfo)
If (DocInfo(i) <> "") then
msg = msg & i & ".: " & DocInfo(i) & CRLF
end if
Next
msgbox msg ,, "Macro Name: " & CWLMacro.MName
End if
GetWinLineDocInfoByAccountAndRunningNr = DocInfo
Else
If DebugMode = "Enabled" Then
MSGBOX "To many Rows found, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNr DocHead from Database table "& SQLTable_DocHead
End If
GetWinLineDocInfoByAccountAndRunningNr = ""
End If
End If
Else
If DebugMode = "Enabled" Then
MSGBOX "Missing Parameter values, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNrDocHead from Database table " & SQLTable_DocHead
End If
GetWinLineDocInfoByAccountAndRunningNr = ""
End If
End Function

103
archive/Modules/Sicherungen/Modules_20230623/GetWinLineDocUniqueByNumber.vbs Normal file
View File

@@ -0,0 +1,103 @@
' GetWinLineDocUniqueIdentifier(GetWinLineDocUniqueIdentifierParams)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: NAME : TYP
' ----------------------------------------------------------------------------
' 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: 01.12.2020 / MK
' Version Date / Editor: 01.12.2020 / MK
' Version Number: 1.0.0.0
Function GetWinLineDocUniqueIdentifier(GetWinLineDocUniqueIdentifierParams)
'SYNOPSIS
'Function will load external - additional - VBS Modules into current Script.
'DESCRIPTION
'By working with Modules, this Function is necessary to load external Module Functions into the current VB-Script.
'Call parameter must be an array, because VB-Script functions cannot handle optional Parameters.
'In develepment and Test Enviroment it is possible, to work with distributed Folders with different Modules. Therefor the Parameter
'"GetWinLineDocUniqueIdentifierParams(1)" (which is the ModuleOverrideSourcePath) and the preset Variable "ModuleDefaultSourcePath" are made for.
'After a successful Import of a Module, Function will return True, otherwise a False.
'REQUIREMENT General
'VBS must be enabled
'REQUIREMENT Assembly
'<NONE>
'REQUIREMENT Variables
'FSOModule, Module, ModuleCode
'REQUIREMENT Variables preSet
'<NONE>
'REQUIREMENT Functions
'<NONE>
'VERSION
'Number: 1.0.0.0 / Date: 01.12.2020
'PARAMETER GetWinLineDocUniqueIdentifierParams(0) = WorkingMode
'Give the
'PARAMETER GetWinLineDocUniqueIdentifierParams(1) = DocAccountAndRunningNr
'Optional Parameter.
'PARAMETER GetWinLineDocUniqueIdentifierParams(2) = DocAccountNr
'Optional Parameter.
'PARAMETER GetWinLineDocUniqueIdentifierParams(3) = DocRunningNr
'Optional Parameter.
'EXAMPLE
'Dim GetWinLineDocUniqueIdentifierParams
'Redim GetWinLineDocUniqueIdentifierParams(0)
'GetWinLineDocUniqueIdentifierParams(0) = Module
'LoadVBSModule(GetWinLineDocUniqueIdentifierParams)
'EXAMPLE
'Dim GetWinLineDocUniqueIdentifierParams
'Redim GetWinLineDocUniqueIdentifierParams(1)
'GetWinLineDocUniqueIdentifierParams(0) = Module
'GetWinLineDocUniqueIdentifierParams(1) = "D:\ScriptFiles\Modules"
'LoadVBSModule(GetWinLineDocUniqueIdentifierParams)
On Error Resume Next
If VarType(GetWinLineDocUniqueIdentifierParams) > 8000 Then
WorkingMode = GetWinLineDocUniqueIdentifierParams(0)
DocAccountAndRunningNr = GetWinLineDocUniqueIdentifierParams(1)
DocAccountNr = GetWinLineDocUniqueIdentifierParams(2)
DocRunningNr = GetWinLineDocUniqueIdentifierParams(3)
IF (WorkingMode = "interactive") or (WorkingMode = "interaktive") Then
GetWinLineDocUniqueIdentifier = DocAccountAndRunningNr
Else
GetWinLineDocUniqueIdentifier = DocAccountAndRunningNr
End If
'If no array was used by calling this function
Else
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MSGBOX "The used Parameter is not an Array!" & vbCrlf & _
"",,"DEBUG Info: Parameter is not an Array - GetWinLineDocUniqueIdentifierParams"
End If
GetWinLineDocUniqueIdentifier = ""
End if
End Function 'GetWinLineDocUniqueIdentifier

49
archive/Modules/Sicherungen/Modules_20230623/GetWinLineInternalProductNumber.vbs Normal file
View File

@@ -0,0 +1,49 @@
' GetWinLineInternalProductNumber(ProductNumber : String, SerialNumber : String)
' ----------------------------------------------------------------------------
' Holt die interne ProductNumber (c002) aus der Artikelview, wenn es eine
' Seriennummer gibt, ansonsten passt der Wert aus dem Parameter
'
' Returns: Interne Artikelnummer
' ----------------------------------------------------------------------------
' 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: 10.08.2020 / MK
' Version Date / Editor: 26.04.2021 / MP
' Version Number: 3.0.0.3
Function GetWinLineInternalProductNumber(ProductNumber, SerialNumber)
Set Conn = CWLStart.CurrentCompany.Connection
Err.Clear
If SerialNumber = "" Then
GetWinLineInternalProductNumber = ProductNumber
Else
SQL = "SELECT [c002] FROM [v021] (NOLOCK) WHERE [c011] = '"& ProductNumber &"' AND [c068] = '"& SerialNumber &"' AND (c038 IS NULL) " & SQLQuery_BasicWhere
Set Result = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Querying for Internal Article Number.. " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "GetWinLineInternalProductNumber"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - GetWinLineInternalProductNumber"
Exit Function
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - GetWinLineInternalProductNumber"
Exit Function
End If
End If
GetWinLineInternalProductNumber = Result.Value("c002")
End If
End Function

60
archive/Modules/Sicherungen/Modules_20230623/GetWinLineOriginalLineNumber.vbs Normal file
View File

@@ -0,0 +1,60 @@
' GetWinLineOriginalLineNumber(OrderNumber : String, ArticleNumber : String, IsSerialNumberArticle : Int)
' ----------------------------------------------------------------------------
' Ermittelt die originale Zeilennummer einer belegposition
'
' 18.02.21 - Wird im Packtisch 3.0 nicht mehr verwendet
'
' Returns: GetWinLineOriginalLineNumber : Int
' ----------------------------------------------------------------------------
' 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: 18.08.2020 / MK
' Version Date / Editor: 26.04.2021 / MP
' Version Number: 3.0.0.3
Function GetWinLineOriginalLineNumber(OrderNumber, ArticleNumber, IsSerialNumberArticle)
Set Conn = CWLStart.CurrentCompany.Connection
Err.Clear
If IsSerialNumberArticle = 1 Then
SQL = "SELECT TOP 1 c078 FROM t026 (NOLOCK) "
SQL = SQL & "WHERE c067 = '"& OrderNumber &"' AND c003 = '"& ArticleNumber &"' "
SQL = SQL & SQLQuery_OrderWhere
Set Result = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Querying for Original Line Number.. " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "GetWinLineOriginalLineNumber"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - GetWinLineOriginalLineNumber"
Exit Function
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - GetWinLineOriginalLineNumber"
Exit Function
End If
End If
GetWinLineOriginalLineNumber = Result.Value("c078")
Else
If DEBUG_ON = True Then
AddDebugLine "Setting Original Line Number to 0.."
ShowDebugBox "GetWinLineOriginalLineNumber"
End If
GetWinLineOriginalLineNumber = "0"
End If
End Function

48
archive/Modules/Sicherungen/Modules_20230623/GetWinLineProductInfoByProductNumber.vbs Normal file
View File

@@ -0,0 +1,48 @@
' GetWinLineProductInfoByProductNumber(ProductNumber : String, WinLineMandatorNr : String, WinLineYear : Int)
' ----------------------------------------------------------------------------
' Läd den passenden Datensatz aus v021 zur übergebenen Artikelnummer
'
' Returns: GetWinLineProductInfoByProductNumber : WinLineProductInfo-Objekt
' ----------------------------------------------------------------------------
' 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: 23.09.2020 / JJ
' Version Date / Editor: 23.09.2020 / JJ
' Version Number: 1.0.0.0
Function GetWinLineProductInfoByProductNumber(ProductNumber, WinLineMandatorNr, WinLineYear)
On Error Resume Next
If (ProductNumber <> "") Then
SQLTable_WinLineProductInfo = "V021"
SQLQuery_WinLineProductInfo = "c011 = '"& ProductNumber &"' and c002 = c011 and MESOCOMP = '"& WinLineMandatorNr &"' AND MESOYEAR = '"& WinLineCurrentYear &"'"
Set SQLResult_WinLineProductInfo = CWLStart.CurrentCompany.SearchRecord (SQLTable_WinLineProductInfo, SQLQuery_WinLineProductInfo)
If (DEBUG_ON = True) or (DebugMode = "Enabled" ) Then
AddDebugLine "Querying for Article Number.. " & vbNewline
AddDebugLine "Result Columns: " & SQLResult_WinLineProductInfo
AddDebugLine "Result Rows: " & SQLResult_WinLineProductInfo.RowCount
AddDebugLine "SQL: " & SQLQuery_WinLineProductInfo
ShowDebugBox "GetWinLineInternalProductNumber"
End If
If (SQLResult_WinLineProductInfo.RowCount = -1) or (SQLResult_WinLineProductInfo.RowCount = 0) Then
GetWinLineProductInfoByProductNumber = 0
Elseif (SQLResult_WinLineProductInfo.RowCount >= 1) Then
Set GetWinLineProductInfoByProductNumber = SQLResult_WinLineProductInfo
End if
End if
End Function

36
archive/Modules/Sicherungen/Modules_20230623/GetWinLineStockedAmount.vbs Normal file
View File

@@ -0,0 +1,36 @@
' GetWinLineStockedAmount(ProductNumber : String, IncludeSalesDocuments : Boolean)
' ----------------------------------------------------------------------------
' Lagerstand des Artikels prüfen
'
' Returns: NAME : TYP
' ----------------------------------------------------------------------------
' 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.01.2021 / XX
' Version Date / Editor: 13.12.2021 / MP
' Version Number: 3.0.0.6
Function GetWinLineStockedAmount(ProductNumber, IncludeSalesDocuments)
SQL = ""
SQL = SQL & "SELECT "
SQL = SQL & " (SELECT C008 - C009 from [v021] (NOLOCK) where (c002 = '__ARTICLENUMBER__') " & SQLQuery_BasicWhere & ") - "
If IncludeSalesDocuments = True Or IncludeSalesDocuments = "True" Or IncludeSalesDocuments = 1 Then
' Include Products from sales documents
SQL = SQL & " ISNULL((SELECT SUM(C035) AS [MengeVerkauf] FROM [t014] (NOLOCK) where c000 = '__ARTICLENUMBER__' "& SQLQuery_BasicWhere &"), 0) "
Else
' Skip Products from sales documents
SQL = SQL & " (SELECT 0) "
End If
SQL = SQL & "AS c000"
SQL = Replace(SQL, "__ARTICLENUMBER__", ProductNumber)
Set Result = CWLStart.CurrentCompany.Connection.Select(SQL)
GetWinLineStockedAmount = Result.Value("c000")
End Function

88
archive/Modules/Sicherungen/Modules_20230623/GetWinLineStorageLocation.vbs Normal file
View File

@@ -0,0 +1,88 @@
' GetWinLineStorageLocation(ProductNumber : String, ProductSerialNumber : String, IsSerialNumberArticle : Int)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: GetWinLineStorageLocation : Int
' ----------------------------------------------------------------------------
' 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: 07.01.2021 / XX
' Version Date / Editor: 23.06.2023 / MK/JJ
' Version Number: 1.1.0.0
'
' 23.06.2023: Lagerortstruktur-SQL erweitert/korrigiert
Function GetWinLineStorageLocation(ProductNumber, ProductSerialNumber, IsSerialNumberArticle)
Set Conn = CWLStart.CurrentCompany.Connection
If IsSerialNumberArticle = 1 Then
' Get 'Lagerortstruktur' for SN Product
SQL = "SELECT TOP 1 c178 FROM [V021] (NOLOCK) WHERE c011 = '"& ProductNumber &"' AND c068 = '" & ProductSerialNumber & "' AND mesocomp = '" & MandatorNr & "' AND mesoyear = " & WinLineCurrentYear & " ORDER BY c029 DESC "
Else
' Get 'Lagerortstruktur' for Non-SN Product
SQL = "SELECT TOP 1 c178 FROM [V021] (NOLOCK) WHERE c011 = '"& ProductNumber &"' AND mesocomp = '" & MandatorNr & "' AND mesoyear = " & WinLineCurrentYear
End If
If DEBUG_ON = True Then
AddDebugLine "SQL Lagerortstruktur: "
AddDebugLine SQL
ShowDebugBox "GetWinLineStorageLocation"
End If
Set Result = Conn.Select(SQL)
If Result.Value("c178") = 0 Then
GetWinLineStorageLocation = 0
Exit Function
End If
If IsSerialNumberArticle = 1 Then
Identifier = GetWinLineInternalProductNumber(ProductNumber, ProductSerialNumber)
Else
Identifier = ProductNumber
End If
SQL = ""
SQL = SQL & "SELECT TOP 1 T335.c000 "
SQL = SQL & "FROM [T024] (NOLOCK), [T335] (NOLOCK), [T299] (NOLOCK) "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C001 AND T335.MESOCOMP = '" & MandatorNr & "' AND (T335.MESOYEAR = " & WinLineCurrentYear & " OR T335.MESOYEAR = " & WinLineCurrentYear - 12 & ")) L1 "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C002 AND T335.MESOCOMP = '" & MandatorNr & "' AND (T335.MESOYEAR = " & WinLineCurrentYear & " OR T335.MESOYEAR = " & WinLineCurrentYear - 12 & ")) L2 "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C003 AND T335.MESOCOMP = '" & MandatorNr & "' AND (T335.MESOYEAR = " & WinLineCurrentYear & " OR T335.MESOYEAR = " & WinLineCurrentYear - 12 & ")) L3 "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C004 AND T335.MESOCOMP = '" & MandatorNr & "' AND (T335.MESOYEAR = " & WinLineCurrentYear & " OR T335.MESOYEAR = " & WinLineCurrentYear - 12 & ")) L4 "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C005 AND T335.MESOCOMP = '" & MandatorNr & "' AND (T335.MESOYEAR = " & WinLineCurrentYear & " OR T335.MESOYEAR = " & WinLineCurrentYear - 12 & ")) L5 "
SQL = SQL & "WHERE T299.C000 = '"& Identifier &"' AND T299.C000 = T024.C002 AND T299.MESOCOMP = '" & MandatorNr & "' AND (T299.MESOYEAR = " & WinLineCurrentYear & " OR T299.MESOYEAR = " & WinLineCurrentYear - 12 & ") AND T024.MESOCOMP = '" & MandatorNr & "' "
SQL = SQL & "AND (T024.MESOYEAR = " & WinLineCurrentYear & " OR T024.MESOYEAR = " & WinLineCurrentYear - 12 & ")AND T335.MESOCOMP = '" & MandatorNr & "' AND (T335.MESOYEAR = " & WinLineCurrentYear & " OR T335.MESOYEAR = " & WinLineCurrentYear - 12 & ") AND (T299.C001 = T335.C020 AND T299.C002 = T335.C021 "
SQL = SQL & "AND T299.C003 = T335.C022 AND T299.C004 = T335.C023 AND T299.C005 = T335.C024 AND T299.C006 = T335.C025) "
SQL = SQL & "ORDER BY T335.c000 DESC, T299.C001,T299.C002,T299.C003,T299.C004,T299.C005,T299.C006"
If DEBUG_ON = True Then
AddDebugLine "SQL Part 1: " & Mid(SQL, 1, 750)
ShowDebugBox "GetWinLineStorageLocation"
AddDebugLine "SQL Part 2: " & Mid(SQL, 750)
ShowDebugBox "GetWinLineStorageLocation"
End If
Set Result = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Querying storage location... " & vbNewline
AddDebugLine "ArticleNumber: " & ProductNumber
AddDebugLine "SerialNumber: " & ProductSerialNumber
AddDebugLine "IsSerialNumber Article: " & IsSerialNumberArticle
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "GetWinLineStorageLocation"
End If
If Result = -1 Then
GetWinLineStorageLocation = 0
Else
GetWinLineStorageLocation = Result.Value("c000")
End If
End Function

74
archive/Modules/Sicherungen/Modules_20230623/GetWinLineUserData.vbm Normal file
View File

@@ -0,0 +1,74 @@
' GetWinLineUserData(UserID: Int)
' ----------------------------------------------------------------------------
' Holt anhand der UserID Loginname, Namen und Durchwahl
' aus der Systemtabelle CWLSYSTEM.T002SRV
'
' Aus den Daten wird ein String aufgebaut, der dann in Meldungen
' verwendet werden kann.
'
' Returns: GetWinLineUserData : String
' ----------------------------------------------------------------------------
' 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: 26.04.2021 / MP
' Version Date / Editor: 26.04.2021 / MP
' Version Number: 3.0.0.3
Function GetWinLineUserData(UserID)
Err.Clear
GetWinLineUserData = ""
If Len(UserID) <= 0 Then
If DEBUG_ON = True Then
Msgbox "Parameter UserID ist leer!", vbExclamation, DEFAULT_TITLE & " - GetWinLineUserData"
End If
Exit Function
End If
Set Conn = CWLCompany.GetSystemConnection(cwlSystemServerSRV)
SQL = "SELECT TOP 1 c001, c026, c028 FROM T002SRV (NOLOCK) "
SQL = SQL & "WHERE c000 = " & UserID
Set Result = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Querying for Original Line Number.. " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "GetWinLineUserData"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - GetWinLineUserData"
Exit Function
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - GetWinLineUserData"
Exit Function
End If
End If
ResultString = ""
If Len(Result.Value("c026")) > 0 Then
' Name des Benutzers
ResultString = Result.Value("c026")
Else
' Loginname des Benutzers, muss immer belegt sein.
ResultString = Result.Value("c001")
End If
If Len(Result.Value("c026")) > 0 Then
' Durchwahl ergänzen, wenn vorhanden
ResultString = ResultString & " (" & Result.Value("c028") & ")"
End If
GetWinLineUserData = ResultString
End Function

29
archive/Modules/Sicherungen/Modules_20230623/GetWindowsEnvironment.vbm Normal file
View File

@@ -0,0 +1,29 @@
' GetWindowsEnvironment(EnvName: String)
' ----------------------------------------------------------------------------
' URL: https://skriptwiki.ffsf.de/doku.php/umgebungsvariablen
'
' Mögliche Werte für EnvName sind hier zu finden:
' http://www.winfaq.de/faq_html/Content/tip0000/onlinefaq.php?h=tip0328.htm
'
' Returns: GetWindowsEnvironment : String
' ----------------------------------------------------------------------------
' 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: 23.03.2021 / MP
' Version Date / Editor: 23.03.2021 / MP
' Version Number: 3.0.0.0
Function GetWindowsEnvironment(EnvName)
If (Len(EnvName) <= 0) Then
GetWindowsEnvironment = ""
Exit Function
End If
Set WshShell = CreateObject("WScript.Shell")
Set oEnv = WshShell.Environment("Process")
GetWindowsEnvironment = oEnv(EnvName)
Set oEnv = Nothing
End Function

234
archive/Modules/Sicherungen/Modules_20230623/Packtisch/ArticleExists.vbs Normal file
View File

@@ -0,0 +1,234 @@
' ArticleExists(Identifier: String)
' ---------------------------------------------------------
' Findet Artikelnummer anhand von versch. Kriterien
' - Artikel-Nummer, Alternative Artikel-Nummer, EAN-Code, Seriennummer
' - Gibt die Zeile im Grid zurück in der Artikel das erste Mal gefunden wurde
'
' Rückgabewert: ArticleRow: Int
' ---------------------------------------------------------
' Version Date: 04.01.2021
Const ARTICLE_EXISTS_NO_STOCK = -99
Const ARTICLE_EXISTS_NO_SERIALNUMBER = -98
Const ARTICLE_EXISTS_NO_ARTICLE_EAN = -97
Const ARTICLE_EXISTS_NO_REGEX_MATCH = -96
Function ArticleExists(Identifier)
ArticleExists = 0
HasError = False
CURRENT_SERIALNUMBER = ""
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
' ===================== ARTIKEL NUMMER / EAN-CODE =====================
SQL = ""
' Artikelnummer / EAN-Code / Alternative Artikelnummer
SQL = SQL & "((C002 = '" & Identifier & "') Or (C075 = '" & Identifier & "') Or (C114 = '" & Identifier & "')) AND "
' Artikel darf nicht inaktiv sein
SQL = SQL & "(c038 IS NULL) "
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set ResultArtikel = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for Article by ArticleNo/EAN-Code.. " & vbNewline & vbNewline
AddDebugLine "Result Columns: " & ResultArtikel & vbNewline
AddDebugLine "Result Rows: " & ResultArtikel.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
' ===================== SERIENNUMMER =====================
SQL = ""
' Artikelnummer
SQL = SQL & "(C068 = '" & Identifier & "') AND "
' Artikel darf nicht inaktiv sein
SQL = SQL & "(c038 IS NULL) "
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set ResultSeriennummer = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for Article by Article serial number " & vbNewline
AddDebugLine "Result Columns: " & ResultSeriennummer
AddDebugLine "Result Rows: " & ResultSeriennummer.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
If ResultSeriennummer.RowCount > 0 Then
SerialNumberString = ResultSeriennummer.Value("C068")
MainArticleNumber = ResultSeriennummer.Value("C011")
SQL = ""
SQL = SQL & "(C002 = '" & MainArticleNumber & "') "
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set ResultMainArticle = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If ResultMainArticle.RowCount > 0 Then
SerialNumberPattern = ResultMainArticle.Value("C222")
End If
If DEBUG_ON = True Then
AddDebugLine "Preparing Regex Check. " & vbNewline
AddDebugLine "SerialNumberString: " & SerialNumberString
AddDebugLine "SerialNumberPattern: " & SerialNumberPattern
AddDebugLine "MainArticleNumber: " & MainArticleNumber
ShowDebugBox "ArticleExists"
End If
If Len(SerialNumberPattern) > 0 And Len(SerialNumberString) > 0 Then
Set SerialNumberRegex = New Regexp
With SerialNumberRegex
.Pattern = SerialNumberPattern
.IgnoreCase = False
.Global = False
End With
Set RegexMatch = SerialNumberRegex.Execute(SerialNumberString)
Set FirstMatch = RegexMatch.Item(0)
If DEBUG_ON = True Then
AddDebugLine "Checked Serialnumber against Regex. (1/2)" & vbNewline
AddDebugLine "FirstMatch.Length: " & FirstMatch.Length
AddDebugLine "Len(SerialNumberString): " & Len(SerialNumberString)
AddDebugLine "FirstMatch.FirstIndex: " & FirstMatch.FirstIndex
ShowDebugBox "ArticleExists"
End If
If Not (FirstMatch.Length = Len(SerialNumberString) And FirstMatch.FirstIndex = 0) Then
ArticleExists = ARTICLE_EXISTS_NO_REGEX_MATCH
HasError = True
End If
If DEBUG_ON = True Then
AddDebugLine "Checked Serialnumber against Regex. (2/2)" & vbNewline
AddDebugLine "Result: " & SerialNumberRegex.Test(SerialNumberString)
AddDebugLine "Serialnumber: " & SerialNumberString
AddDebugLine "Regex: " & SerialNumberPattern
ShowDebugBox "ArticleExists"
End If
End If
CURRENT_SERIALNUMBER = Identifier
Set Result = ResultSeriennummer
Else
Set Result = ResultArtikel
End If
'==========================================================
If HasError = True Then
' Just skip the rest of the function and return the current error
Elseif Result.RowCount > 0 Then
' Wir brauchen die Hauptartikelnummer, weil die Prüfung sonst bei SN-Artikeln fehlschlägt
MainArticleNumber = Result.Value("C011")
RealArticleNumber = Result.Value("C002")
ProductShape = 0
' Ausprägung des Artikels prüfen
SQL = ""
SQL = "SELECT c001 FROM t301 (NOLOCK) WHERE c003 = (SELECT c066 FROM v021 (NOLOCK) WHERE c002 = '" & RealArticleNumber & "' " & SQLQuery_BasicWhere & ")" & SQLQuery_BasicWhere
If DEBUG_ON = True Then
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
Set Result = CWLStart.CurrentCompany.Connection.Select(SQL)
If Result > -1 Then
ProductShape = Result.Value("c001")
Else
ProductShape = 0
End If
CURRENT_SHAPE = ProductShape
' Lagerstand des Artikels prüfen
SQL = ""
SQL = SQL & "SELECT "
SQL = SQL & "(SELECT C008 AS [MengeZugang] from [v021] (NOLOCK) where (c002 = '__ARTICLENUMBER__') "& SQLQuery_BasicWhere &")"
SQL = SQL & " - "
SQL = SQL & "(SELECT C009 AS [MengeAbgang] from [v021] (NOLOCK) where (c002 = '__ARTICLENUMBER__') "& SQLQuery_BasicWhere &") "
'SQL = SQL & " - "
'SQL = SQL & "ISNULL((SELECT SUM(C035) AS [MengeVerkauf] FROM [t014] (NOLOCK) where c000 = '__ARTICLENUMBER__' "& SQLQuery_BasicWhere &"), 0)"
SQL = SQL & " AS c000"
SQL = Replace(SQL, "__ARTICLENUMBER__", RealArticleNumber)
If DEBUG_ON = True Then
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
Set Result = CWLStart.CurrentCompany.Connection.Select(SQL)
AmountStocked = Result.Value("c000")
If DEBUG_ON = True Then
AddDebugLine "Checking stock of product: " & RealArticleNumber & " (" & MainArticleNumber & ")" & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "Stock: " & AmountStocked
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
If AmountStocked > 0 Then
If DEBUG_ON = True Then
AddDebugLine "Amount stocked: " & AmountStocked
End If
' Vorkommen in Tabelle prüfen
For Row = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(Row, COLUMN_ARTICLENUMBER)
Total = Cint(Grid.GetCellValue(Row, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(Row, COLUMN_SCANNED))
If CurrentArticleNumber = MainArticleNumber Then
If DEBUG_ON = True Then
AddDebugLine "CurrentArticleNumber matches MainArticleNumber! (" & CurrentArticleNumber & ")"
End If
If Total > Scanned Then
If DEBUG_ON = True Then
AddDebugLine "Product is not yet scanned completetly and exists in Row " & Row & "!"
End If
ArticleExists = Row
Exit For
End If
End If
Next
Else
If DEBUG_ON = True Then
AddDebugLine "Amount stocked: 0"
End If
ArticleExists = ARTICLE_EXISTS_NO_STOCK
End If
If DEBUG_ON = True Then
ShowDebugBox "ArticleExists"
End If
Else
If CURRENT_SERIALNUMBER = "" Then
ArticleExists = ARTICLE_EXISTS_NO_ARTICLE_EAN
Else
ArticleExists = ARTICLE_EXISTS_NO_SERIALNUMBER
End If
End If
End Function

210
archive/Modules/Sicherungen/Modules_20230623/Packtisch/CompleteOrder.vbs Normal file
View File

@@ -0,0 +1,210 @@
' CompleteOrder()
' ---------------------------------------------------------
' Schließt die Prüfung ab und erstellt einen Lieferschein
'
' Rückgabewert: OrderSuccessful : Boolean
' ---------------------------------------------------------
' Version Date: 05.01.2021
Function CompleteOrder()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Conn = CWLStart.CurrentCompany.Connection
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Dim OrderId, AccountSQL, MandatorId, RunningNumber
If DEBUG_ON = True Then
AddDebugLine "Completing order.. " & vbNewline
ShowDebugBox "CompleteOrder"
End If
OrderId = mywin.Controls.Item(ORDER_INPUT).ScreenContents
AccountSQL = "SELECT DISTINCT c021 FROM t025 (NOLOCK) WHERE c044 = '" & OrderId & "' " & SQLQuery_OrderWhere
Set AccountResult = Connection.Select(AccountSQL)
If DEBUG_ON = True Then
AddDebugLine "Querying for CustomerAccountId.. " & vbNewline
AddDebugLine "Result Columns: " & AccountResult
AddDebugLine "Result Rows: " & AccountResult.RowCount
AddDebugLine "SQL: " & AccountSQL
ShowDebugBox "CompleteOrder"
End If
MandatorId = AccountResult.Value("c021")
RunningNumber = RUNNING_NUMBER_PREFIX & OrderId
BelegKey = Cstr(DateDiff("s", "01/01/1970 00:00:00", Now))
' ===================== KOPFDATEN =====================
Dim Request, URL, XML
Dim DObj : DObj = Now
Dim DateString : DateString = Year(DObj) & "-" & GetLeftPad(Month(DObj)) & "-" & GetLeftPad(Day(DObj))
' === WEB SERVICES =======================
XML = ""
XML = XML & "<?xml version=""1.0"" encoding=""UTF-8""?>"
XML = XML & "<MESOWebService TemplateType=""__TYPE__"" Template=""__VORLAGE__"" option=""__OPTION__"" printVoucher=""__PRINT__"">"
XML = XML & "<__VORLAGE__T025>"
XML = XML & "<BELEGKEY>" & BelegKey & "</BELEGKEY>"
XML = XML & "<Kontonummer>" & MandatorId & "</Kontonummer>"
XML = XML & "<Laufnummer>" & RunningNumber & "</Laufnummer>"
XML = XML & "<Auftragsnummer>" & OrderId & "</Auftragsnummer>"
XML = XML & "<Datum_Lieferschein>" & DateString & "</Datum_Lieferschein>"
XML = XML & "</__VORLAGE__T025>"
' === EXIM TABELLE =======================
HeadSQL = "INSERT INTO " & SQLDB_for_EXIM & "." & SQLHeadTB_for_EXIM & " "
HeadSQL = HeadSQL & "(BELEGKEY, Kontonummer, Laufnummer, Auftragsnummer, Belegdatum) "
HeadSQL = HeadSQL & "VALUES("& BelegKey &", '"& MandatorId &"', '"& RunningNumber &"', '"& OrderId &"', GETDATE())"
HeadResult = Conn.ExecuteSQL(HeadSQL)
If DEBUG_ON = True Then
AddDebugLine "Inserting Head Data" & vbNewline
AddDebugLine "Result: " & HeadResult
AddDebugLine "SQL: " & HeadSQL
ShowDebugBox "CompleteOrder"
End If
' ===================== ENDE KOPFDATEN =====================
' ============================ MITTEDATEN ============================
Dim ArticleNumber, AmountScanned, SerialNumber, StorageLocation, LineNumber
For Row = 1 To Grid.LineCount
IsSerialNumberArticle = Grid.GetCellValue(Row, COLUMN_TYPE)
ArticleNumber = Grid.GetCellValue(Row, COLUMN_ARTICLENUMBER)
SerialNumber = Grid.GetCellValue(Row, COLUMN_SERIALNUMBER)
AmountScanned = Grid.GetCellValue(Row, COLUMN_SCANNED)
AmountTotal = Grid.GetCellValue(Row, COLUMN_TOTAL)
If PRINT_DOCUMENT_AFTER_COMPLETION = True Then
StorageLocation = GetWinLineStorageLocation(ArticleNumber, SerialNumber, IsSerialNumberArticle)
InternalArticleNumber = GetWinLineInternalProductNumber(ArticleNumber, SerialNumber)
Else
StorageLocation = 0
InternalArticleNumber = 0
End If
LineNumber = GetWinLineOriginalLineNumber(OrderId, ArticleNumber, IsSerialNumberArticle)
' === EXIM TABELLE =======================
If IsSerialNumberArticle = 1 Then
MidSQL = "INSERT INTO " & SQLDB_for_EXIM & "." & SQLMiddleTB_for_EXIM & " "
MidSQL = MidSQL & "(BELEGKEY, Artikelnummer, Hauptartikelnummer, Zeilennummer, Datentyp, Mengegeliefert, ChargeIdentnummer, Lagerort) "
MidSQL = MidSQL & "VALUES("& BelegKey &", '"& ArticleNumber &"', '"& ArticleNumber &"', "& LineNumber &", '1', "& AmountScanned &", '"& SerialNumber &"', "& StorageLocation &")"
Else
MidSQL = "INSERT INTO " & SQLDB_for_EXIM & "." & SQLMiddleTB_for_EXIM & " "
MidSQL = MidSQL & "(BELEGKEY, Artikelnummer, Hauptartikelnummer, Zeilennummer, Datentyp, Mengegeliefert, ChargeIdentnummer, Lagerort) "
MidSQL = MidSQL & "VALUES("& BelegKey &", '"& ArticleNumber &"', '"& ArticleNumber &"', NULL, '1', "& AmountScanned &", '"& SerialNumber &"', "& StorageLocation &")"
End If
MidResult = Conn.ExecuteSQL(MidSQL)
' === WEB SERVICES =======================
MidXML = ""
MidXML = MidXML & "<__VORLAGE__T026>"
MidXML = MidXML & "<BELEGKEY>" & BelegKey & "</BELEGKEY>"
MidXML = MidXML & "<Artikelnummer>" & InternalArticleNumber & "</Artikelnummer>"
MidXML = MidXML & "<Hauptartikelnummer>" & ArticleNumber & "</Hauptartikelnummer>"
MidXML = MidXML & "<Zeilennummer>" & LineNumber & "</Zeilennummer>"
MidXML = MidXML & "<Datentyp>" & "1" & "</Datentyp>"
MidXML = MidXML & "<Mengegeliefert>" & AmountScanned & "</Mengegeliefert>"
MidXML = MidXML & "<ChargeIdentnummer>" & SerialNumber & "</ChargeIdentnummer>"
MidXML = MidXML & "<Lagerort>" & StorageLocation & "</Lagerort>"
MidXML = MidXML & "</__VORLAGE__T026>"
If DEBUG_ON = True Then
AddDebugLine "Inserting Middle Data" & vbNewline
AddDebugLine "For Article " & ArticleNumber
AddDebugLine "And Amount " & AmountScanned
AddDebugLine "Result: " & MidResult & vbNewline
AddDebugLine "SQL: " & MidSQL & vbNewline
AddDebugLine "XML: " & MidXML
ShowDebugBox "CompleteOrder"
End If
XML = XML & MidXML
Next
XML = XML & "</MESOWebService>"
XML = Replace(XML, "__VORLAGE__", WEB_VORLAGE)
XML = Replace(XML, "__TYPE__", WEB_TYPE)
XML = Replace(XML, "__PRINT__", WEB_PRINT)
XML = Replace(XML, "__OPTION__", WEB_OPTION)
URL = "http://__SERVER__/ewlservice/import?User=__USER__&Password=__PASSWORD__&Company=__COMPANY__&Type=30&Vorlage=__VORLAGE__&Actioncode=__ACTIONCODE__&byref=0&Data=__DATA__"
URL = Replace(URL, "__SERVER__", WEB_SERVER)
URL = Replace(URL, "__USER__", WEB_USER)
URL = Replace(URL, "__PASSWORD__", WEB_PASS)
URL = Replace(URL, "__COMPANY__", WEB_COMPANY)
URL = Replace(URL, "__VORLAGE__", WEB_VORLAGE)
URL = Replace(URL, "__ACTIONCODE__", WEB_ACTIONCODE)
URL = Replace(URL, "__DATA__", XML)
If DEBUG_ON = True Then
AddDebugLine "Sending Request to WebServices.."
AddDebugLine "URL: " & URL
AddDebugLine "WEB_PRINT: " & WEB_PRINT
AddDebugLine "WEB_OPTION: " & WEB_OPTION
ShowDebugBox "CompleteOrder"
End If
' ======================= ENDE MITTEDATEN =======================
If PRINT_DOCUMENT_AFTER_COMPLETION = True Then
' ===================== HTTP REQUEST =====================
Set Request = CreateObject("MSXML2.XMLHTTP")
Request.Open "POST", URL, False
Request.Send
Response = Request.ResponseText
Status = Request.Status
If DEBUG_ON = True Then
AddDebugLine "Response from WebServices!"
AddDebugLine "Status: " & Status
AddDebugLine "Body: " & Response
ShowDebugBox "CompleteOrder"
End If
' =================== ENDE HTTP REQUEST ==================
Error = False
Message = ""
If Status = 200 Then
If TestIsWebserviceResponseSuccessful(Response) = True Then
Message = "Lieferschein wurde uebertragen!"
Else
Error = True
Message = "Lieferschein wurde nicht uebertragen! Fehlerdetails: " & vbNewline & vbNewline & Response
End If
Else
Error = True
Message = "Fehler beim Zugriff auf Webservices aufgetreten!" & vbNewline & vbNewline & "Status: " & Status
End If
If Error = False Then
MsgBox Message, vbInformation, DEFAULT_TITLE
CompleteOrder = True
Else
MsgBox Message, vbExclamation, DEFAULT_TITLE & " - Fehler bei Abschluss"
CompleteOrder = False
End If
Else
CompleteOrder = True
End If
End Function

20
archive/Modules/Sicherungen/Modules_20230623/Packtisch/CountRowsForArticle.vbs Normal file
View File

@@ -0,0 +1,20 @@
Function CountRowsForArticle(ArticleNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Dim Count : Count = 0
If DEBUG_ON = True Then
AddDebugLine "Counting rows for Article: " & ArticleNumber
ShowDebugBox "CountRowsForArticle"
End If
For Row = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(Row, COLUMN_ARTICLENUMBER)
If ArticleNumber = CurrentArticleNumber Then
Count = Count + 1
End If
Next
CountRowsForArticle = Count
End Function

34
archive/Modules/Sicherungen/Modules_20230623/Packtisch/GetArticleNumberFromSecondaryIndentifier.vbs Normal file
View File

@@ -0,0 +1,34 @@
' Version Date: 23.11.2020
Function GetArticleNumberFromSecondaryIndentifier(Identifier)
SQL = ""
' EAN-Code / Alternative Artikelnummer 1 / Alternative Artikelnummer 2 / Artikelnummer / S/N
SQL = SQL & "("
SQL = SQL & "(C002 = '" & Identifier & "') Or "
SQL = SQL & "(C068 = '" & Identifier & "') Or "
SQL = SQL & "(C075 = '" & Identifier & "') Or "
SQL = SQL & "(C114 = '" & Identifier & "') Or "
SQL = SQL & "(C115 = '" & Identifier & "')"
SQL = SQL & ") "
' Nur Nach Hauptartikel/Ausprägungs(kind)artikel suchen
' SQL = SQL & "And C014 IN (0, 2)"
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set Result = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for SerialNumber-Regex by ArticleNumber " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "GetArticleNumberFromSecondaryIndentifier"
End If
If Result.RowCount > 0 Then
GetArticleNumberFromSecondaryIndentifier = Result.Value("c010")
Else
GetArticleNumberFromSecondaryIndentifier = ""
End If
End Function

23
archive/Modules/Sicherungen/Modules_20230623/Packtisch/GetNextFreeArticleRow.vbs Normal file
View File

@@ -0,0 +1,23 @@
' Version Date: 30.09.2020
Function GetNextFreeArticleRow(ArticleNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Dim NextFreeRow : NextFreeRow = -1
If DEBUG_ON = True Then
AddDebugLine "Getting next free row for Article: " & ArticleNumber
ShowDebugBox "GetNextFreeArticleRow"
End If
For Row = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(Row, COLUMN_ARTICLENUMBER)
CurrentSerialNumber = Grid.GetCellValue(Row, COLUMN_SERIALNUMBER)
If UCase(ArticleNumber) = UCase(CurrentArticleNumber) And Len(CurrentSerialNumber) = 0 Then
NextFreeRow = Row
Exit For
End If
Next
GetNextFreeArticleRow = NextFreeRow
End Function

58
archive/Modules/Sicherungen/Modules_20230623/Packtisch/IsOrderAvailable.vbs Normal file
View File

@@ -0,0 +1,58 @@
' IsOrderAvailable()
' ---------------------------------------------------------
' Überprüft, ob Auftrag noch (teilweise) offen ist
'
' Rückgabewert: OrderAvailable: Boolean
' ---------------------------------------------------------
Function IsOrderAvailable(OrderNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
IsOrderAvailable = False
'Set SQL Table and Query for DocHead. Default: "T025"
'c023 - c026 = Druckstufen; c098 = Freigabeflag Angebot; c139 = Belegstufe;
'c035 = Belegart
'--> Query is not complete, will be build in the script later this time!
SQL = ""
SQL = SQL & "(c044 = '" & OrderNumber & "') "
SQL = SQL & "AND (c024 = '*' AND c025 != '*' AND c026 != '*') "
SQL = SQL & "AND (c025 IN ('M', 'A', 'S')) "
SQL = SQL & "AND (c115 < 900) "
SQL = SQL & "AND (c139 = 2) "
SQL = SQL & SQLQuery_OrderWhere
Set Result = CWLStart.CurrentCompany.SearchRecord(TABLE_25, SQL)
If DEBUG_ON = True Then
MsgBox "SQL: ... FROM " & TABLE_25 & " WHERE " & SQL, vbOkonly, DEBUG_TITLE
AddDebugLine "Checking For Order by OrderId.." & vbNewline & vbNewline
AddDebugLine "Result Columns: " & Result & vbNewline
AddDebugLine "Result Rows: " & Result.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "IsOrderAvailable"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - IsOrderAvailable"
Exit Function
Else
Message = "Der Auftrag [" & OrderNumber & "] wurde nicht geladen aus einem der folgenden Gründe:" & vbNewLine & vbNewLine
Message = Message & "- Auftrag existiert nicht" & vbNewLine
Message = Message & "- Auftrag ist durch Fibu gesperrt" & vbNewLine
Message = Message & "- Auftrag wurde bereits erledigt" & vbNewLine
Message = Message & "- Beleg ist kein Auftrag"
MsgBox Message, vbExclamation, DEFAULT_TITLE
Exit Function
End If
End If
If Result.RowCount > 0 Then
IsOrderAvailable = True
End If
End Function

22
archive/Modules/Sicherungen/Modules_20230623/Packtisch/IsOrderComplete.vbs Normal file
View File

@@ -0,0 +1,22 @@
' IsOrderComplete()
' ---------------------------------------------------------
' Überprüft, ob alle Zeilen vollständig gescannt wurden
'
' Rückgabewert: OrderComplete: Boolean
' ---------------------------------------------------------
Function IsOrderComplete()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
IsOrderComplete = True
For Row = 1 To Grid.LineCount
Total = Cint(Grid.GetCellValue(Row, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(Row, COLUMN_SCANNED))
If Scanned < Total Then
IsOrderComplete = False
Exit For
End If
Next
End Function

153
archive/Modules/Sicherungen/Modules_20230623/Packtisch/LoadOrder.vbs Normal file
View File

@@ -0,0 +1,153 @@
' LoadOrder(OrderNumber: String)
' ---------------------------------------------------------
' Sucht Belegzeilen zur angegebenen Belegnummer
' - Filtert Artikel der Gruppe 100 aus
' - Lädt Ergebnisse in eine Tabelle auf dem Formular
' - Erzeugt N Zeilen für Seriennummer-Artikel der Menge N
'
' Rückgabewert: LoadSuccessful: Boolean
' ---------------------------------------------------------
' Version Date: 04.01.2021
Function LoadOrder(OrderNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
' ARTIKEL FILTERN
SQL = ""
' Nach eingescannter Auftragsnummer/Belegnummer filtern
SQL = SQL & "(c067 = '"& OrderNumber &"') "
' Nur Artikelzeilen anzeigen
SQL = SQL & "AND (c042 = 1) "
' Teillieferungs-Zeilen rausfiltern
SQL = SQL & "AND (c005 - c016) > 0 AND (c099 = 0) "
'SQL = SQL & "AND c039 <> '*' AND (c005 - c016) > 0 AND (c099 = 0) "
' Versandkosten (Art.Gruppe 100) rausfiltern
' SQL = SQL & "AND c012 NOT IN (100, 101) "
' Keine Hauptartikel, wenn dazu auch Ausprägungen vorhanden sind
' Legende:
'-1 - Ausprägung
' 0 - HA ohne Ausprägungen
' 2 - HA mit Ausprägungen + Ident
' 12 - HA mit Ausprägungen + Ident (bereits ausgeprägt)
SQL = SQL & "AND c055 NOT IN (12)"
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_OrderWhere
Set Result = CWLStart.CurrentCompany.SearchRecord (TABLE_26, SQL)
If DEBUG_ON = True Then
MsgBox "SQL: ... FROM "& TABLE_26 & " WHERE " & SQL, vbOkonly, DEBUG_TITLE
AddDebugLine "Searching For Order by OrderId (Mid Table).." & vbNewline & vbNewline
AddDebugLine "Result Columns: " & Result & vbNewline
AddDebugLine "Result Rows: " & Result.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "LoadOrder"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - LoadOrder"
Exit Function
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - LoadOrder"
Exit Function
End If
End If
Grid.InitUserGrid
Grid.Header
Grid.Clear(1002)
Grid.IsRedraw = False
If Result.RowCount > 0 Then
LineCounter = 1
' Speicher für benutzerdefinierte Felder
' (495,0) - Menge Gescannt
' (495,1) - Menge Gesamt
' (495,2) - Seriennummer
' (495,3) - Artikelnummer
' (495,4) - Bezeichnung
ORDER_ACCOUNT_NUMBER = Result.Value("c044")
ORDER_RUNNING_NUMBER = Result.Value("c045")
ORDER_DOCUMENT_NUMBER = Result.Value("c067")
Do
' Zeilen hochzählen
Dim AmountOrdered, AmountDelivered
AmountOrdered = Cint(Result.Value("c005"))
AmountDelivered = Cint(Result.Value("c016"))
ProductGroup = Cint(Result.Value("c012"))
Amount = AmountOrdered - AmountDelivered
ChargeFlag = Cint(Result.Value("c055"))
If ChargeFlag = 2 Then
For index = 1 To Amount
Dim IsLateShape
SQL = "(C002 = '" & Result.Value("c003") & "')"
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set ShapeResult = CWLStart.CurrentCompany.SearchRecord (TABLE_21, SQL)
If Len(ShapeResult.Value("C222")) > 0 Then
IsLateShape = 1
Else
IsLateShape = 0
End If
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = 1
CWLCurrentWindow.ActiveWindow.Vars.Value(495,1) = 0
CWLCurrentWindow.ActiveWindow.Vars.Value(495,2) = ""
CWLCurrentWindow.ActiveWindow.Vars.Value(495,3) = Result.Value("c003")
CWLCurrentWindow.ActiveWindow.Vars.Value(495,4) = Result.Value("c004")
CWLCurrentWindow.ActiveWindow.Vars.Value(495,5) = 1
CWLCurrentWindow.ActiveWindow.Vars.Value(495,6) = IsLateShape
Grid.AddLine
' Zeilenfarbe mit ROT vorbelegen
Grid.SetLineColor LineCounter, COLOR_RED
LineCounter = LineCounter + 1
Next
Else
If ProductGroup >= 100 Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = Amount
CWLCurrentWindow.ActiveWindow.Vars.Value(495,1) = Amount
LineColor = COLOR_GREEN
Else
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = Amount
CWLCurrentWindow.ActiveWindow.Vars.Value(495,1) = 0
LineColor = COLOR_RED
End If
CWLCurrentWindow.ActiveWindow.Vars.Value(495,2) = ""
CWLCurrentWindow.ActiveWindow.Vars.Value(495,3) = Result.Value("c003")
CWLCurrentWindow.ActiveWindow.Vars.Value(495,4) = Result.Value("c004")
CWLCurrentWindow.ActiveWindow.Vars.Value(495,5) = 0
CWLCurrentWindow.ActiveWindow.Vars.Value(495,6) = 0
' Ergebnisse aus SQL in Zeile schreiben
Grid.AddLine
' Zeilenfarbe mit ROT vorbelegen
Grid.SetLineColor LineCounter, LineColor
LineCounter = LineCounter + 1
End If
Loop While Result.NextRecord = True
Else
MsgBox "Beim Laden des Auftrags ["& OrderNumber &"] wurden keine Zeilen zurück gegeben.", vbExclamation, DEFAULT_TITLE
LoadOrder = False
End If
LoadOrder = True
Grid.IsRedraw = True
End Function

16
archive/Modules/Sicherungen/Modules_20230623/Packtisch/SerialNumberExists.vbs Normal file
View File

@@ -0,0 +1,16 @@
' Version Date: 25.09.2020
Function SerialNumberExists(SerialNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
SerialNumberExists = False
For Row = 1 To Grid.LineCount
CurrentSerialNumber = Grid.GetCellValue(Row, COLUMN_SERIALNUMBER)
If SerialNumber = CurrentSerialNumber Then
SerialNumberExists = True
Exit For
End If
Next
End Function

76
archive/Modules/Sicherungen/Modules_20230623/Packtisch/SerialNumberMatches.vbs Normal file
View File

@@ -0,0 +1,76 @@
' Version Date: 05.01.2021
Function SerialNumberMatches(ArticleNumber, SerialNumber)
HasError = False
SQL = ""
SQL = SQL & "(C002 = '" & ArticleNumber & "')"
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set ResultMainArticle = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If ResultMainArticle.RowCount > 0 Then
SerialNumberPattern = ResultMainArticle.Value("C222")
End If
If DEBUG_ON = True Then
AddDebugLine "Preparing Regex Check. " & vbNewline
AddDebugLine "SerialNumber: " & SerialNumber
AddDebugLine "SerialNumberPattern: " & SerialNumberPattern
AddDebugLine "ArticleNumber: " & ArticleNumber
ShowDebugBox "SerialNumberMatches"
End If
If Len(SerialNumberPattern) > 0 And Len(SerialNumber) > 0 Then
Set SerialNumberRegex = New Regexp
SerialNumberRegex.Pattern = SerialNumberPattern
SerialNumberRegex.IgnoreCase = False
SerialNumberRegex.Global = False
Set RegexMatch = SerialNumberRegex.Execute(SerialNumber)
If RegexMatch.Count > 0 Then
Set FirstMatch = RegexMatch.Item(0)
If DEBUG_ON = True Then
AddDebugLine "Checked Serialnumber against Regex. (1/2)" & vbNewline
AddDebugLine "FirstMatch.Length: " & FirstMatch.Length
AddDebugLine "Len(SerialNumber): " & Len(SerialNumber)
AddDebugLine "FirstMatch.FirstIndex: " & FirstMatch.FirstIndex
ShowDebugBox "SerialNumberMatches"
End If
If FirstMatch.Length = Len(SerialNumber) And FirstMatch.FirstIndex = 0 Then
HasError = False
Else
HasError = True
End If
If DEBUG_ON = True Then
AddDebugLine "Checked Serialnumber against Regex. (2/2)" & vbNewline
AddDebugLine "Result: " & SerialNumberRegex.Test(SerialNumber)
AddDebugLine "Serialnumber: " & SerialNumber
AddDebugLine "Regex: " & SerialNumberPattern
ShowDebugBox "SerialNumberMatches"
End If
Else
HasError = True
End If
Else
HasError = True
End If
If HasError = True Then
SerialNumberMatches = False
Else
SerialNumberMatches = True
End If
End Function

18
archive/Modules/Sicherungen/Modules_20230623/Packtisch/SetAmount.vbs Normal file
View File

@@ -0,0 +1,18 @@
' SetAmount(Amount: Integer)
' ---------------------------------------------------------
' Setzt eigegeben Menge in das Mengenfeld
' - Überschreibt Menge beim ersten Eintrag, danach
' wird die Zahl angehängt
'
' Rückgabewert: Keiner
' ---------------------------------------------------------
Sub SetAmount(Amount)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
If amountBox.Contents = AMOUNT_PLACEHOLDER Then
amountBox.Contents = Cstr(Amount)
Else
amountBox.Contents = amountBox.Contents & Cstr(Amount)
End If
End Sub

47
archive/Modules/Sicherungen/Modules_20230623/Packtisch/SetupWindow.vbs Normal file
View File

@@ -0,0 +1,47 @@
' Version Date: 01.10.2020
Sub SetupWindow()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
' Speicher für benutzerdefinierte Felder
' (495,0) - Menge Gescannt
' (495,1) - Menge Gesamt
' (495,2) - Seriennummer
' (495,3) - Artikelnummer
' (495,4) - Bezeichnung
' (495,5) - Chargen-/Identflag
' (495,5) - Spät ausgeprägt bzw. Regex vorhanden
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 0, "2", 10
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 1, "2", 10
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 2, "1", 20
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 3, "1", 20
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 4, "1", 60
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 5, "2", 3
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 6, "2", 3
Grid.InitUserGrid
Grid.IsRedraw = False
Grid.Header
If COLUMNS_CREATED = False Then
COLUMN_ARTICLENUMBER = Grid.AddColumn("Artikelnummer", "T21,Artikelnummer", "1","V",0,495,3,20,scrtflag+sizeflag+hideflag)
COLUMN_DESCRIPTION = Grid.AddColumn("Bezeichnung", "T21,Bezeichnung", "1","V",0,495,4,30,scrtflag+sizeflag+hideflag)
COLUMN_TOTAL = Grid.AddColumn("Gesamt", "T22,Gesamt", "1","V",0,495,0,10,scrtflag+sizeflag+hideflag)
COLUMN_SCANNED = Grid.AddColumn("Gescannt", "T22,Gescannt", "1","V",0,495,1,10,scrtflag+sizeflag+hideflag)
COLUMN_SERIALNUMBER = Grid.AddColumn("Seriennummer", "T21,Seriennummer", "l","V",0,495,2,20,scrtflag+sizeflag+hideflag)
COLUMN_TYPE = Grid.AddColumn("S/N?", "T17,Seriennummer", "l","V",0,495,5,6,scrtflag+sizeflag+hideflag)
COLUMN_LATE_SHAPE = Grid.AddColumn("Auspr?", "T17,Spaetausgepr.", "l","V",0,495,6,6,scrtflag+sizeflag+hideflag)
COLUMNS_CREATED = True
End If
Grid.IsRedraw = True
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
amountBox.Contents = AMOUNT_PLACEHOLDER
Set articleBox = mywin.Controls.Item(ARTICLE_INPUT)
articleBox.Contents = ""
MacroCommands.MSetFieldFocus WINDOW_ID, ORDER_INPUT
End Sub

55
archive/Modules/Sicherungen/Modules_20230623/Packtisch/TestArticleHasSerialNumberRegex.vbs Normal file
View File

@@ -0,0 +1,55 @@
' TestArticleHasSerialNumberRegex(Identifier: String)
' ---------------------------------------------------------
' Findet Artikelnummer anhand von versch. Kriterien
' - Artikel-Nummer, Alternative Artikel-Nummer, EAN-Code, Seriennummer
' - Gibt die Zeile im Grid zurück in der Artikel das erste Mal gefunden wurde
'
' Rückgabewert: ArticleRow: Int
' ---------------------------------------------------------
' Version Date: 25.09.2020
Function TestArticleHasSerialNumberRegex(Identifier)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
If DEBUG_ON = True Then
AddDebugLine "Testing for Regex in Identifier: " & Identifier
ShowDebugBox "TestArticleHasSerialNumberRegex"
End If
SQL = ""
' Artikelnummer / EAN-Code / Alternative Artikelnummer
SQL = SQL & "((C002 = '" & Identifier & "') Or (C075 = '" & Identifier & "') Or (C114 = '" & Identifier & "')) AND "
' Serienummer-Regex muss vorhanden sein
SQL = SQL & "(C222 IS NOT NULL) AND "
' Artikel darf nicht inaktiv sein
SQL = SQL & "(c038 IS NULL) "
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
If DEBUG_ON = True Then
AddDebugLine "SQL: " & SQL
ShowDebugBox "TestArticleHasSerialNumberRegex"
End If
Set Result = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for SerialNumber-Regex by ArticleNumber " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "TestArticleHasSerialNumberRegex"
End If
If Result.RowCount > 0 Then
TestArticleHasSerialNumberRegex = True
Else
TestArticleHasSerialNumberRegex = False
End If
End Function

23
archive/Modules/Sicherungen/Modules_20230623/Packtisch/TestHasFreeArticleRow.vbs Normal file
View File

@@ -0,0 +1,23 @@
' Version Date: 25.09.2020
Function TestHasFreeArticleRow(ArticleNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Dim NextFreeRow : NextFreeRow = False
If DEBUG_ON = True Then
AddDebugLine "Getting next free row for Article: " & ArticleNumber
ShowDebugBox "TestHasFreeArticleRow"
End If
For Row = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(Row, COLUMN_ARTICLENUMBER)
CurrentSerialNumber = Grid.GetCellValue(Row, COLUMN_SERIALNUMBER)
If UCase(ArticleNumber) = UCase(CurrentArticleNumber) And Len(CurrentSerialNumber) = 0 Then
NextFreeRow = True
Exit For
End If
Next
TestHasFreeArticleRow = NextFreeRow
End Function

47
archive/Modules/Sicherungen/Modules_20230623/Packtisch/TestIsWebserviceResponseSuccessful.vbs Normal file
View File

@@ -0,0 +1,47 @@
' Version Date: 30.09.2020
Function TestIsWebserviceResponseSuccessful(XmlString)
' Check if XmlString is actually a xml string
If InStr(XmlString, "<?xml") = 1 Then
Set Doc = CreateObject("MSXML2.DOMDocument")
Doc.loadXML(XmlString)
Set Nodes = Doc.SelectNodes("MESOWebServiceResult/ResultDetails")
Set OverallSuccess = Doc.SelectSingleNode("MESOWebServiceResult/OverallSuccess")
If OverallSuccess.Text = "true" Then
Dim IsSuccess : IsSuccess = True
For Each Node in Nodes
Set Success = Node.SelectSingleNode("Success")
If Success.Text <> "true" Then
IsSuccess = False
End If
Next
TestIsWebserviceResponseSuccessful = IsSuccess
Else
TestIsWebserviceResponseSuccessful = False
End If
Else
TestIsWebserviceResponseSuccessful = False
End If
End Function
Function prettyXml(ByVal sDirty)
' Put whitespace between tags. (Required for XSL transformation.)
sDirty = Replace(sDirty, "><", ">" & vbCrLf & "<")
' Create an XSL stylesheet for transformation.
Dim objXSL : Set objXSL = WScript.CreateObject("Msxml2.DOMDocument")
objXSL.loadXML "<xsl:stylesheet version=""1.0"" xmlns:xsl=""http://www.w3.org/1999/XSL/Transform"">" & _
"<xsl:output method=""xml"" indent=""yes""/>" & _
"<xsl:template match=""/"">" & _
"<xsl:copy-of select="".""/>" & _
"</xsl:template>" & _
"</xsl:stylesheet>"
' Transform the XML.
Dim objXML : Set objXML = WScript.CreateObject("Msxml2.DOMDocument")
objXML.loadXml sDirty
objXML.transformNode objXSL
prettyXml = objXML.xml
End Function

60
archive/Modules/Sicherungen/Modules_20230623/Packtisch/UpdateArticleRow.vbs Normal file
View File

@@ -0,0 +1,60 @@
' UpdateArticleRow(RowNumber: Integer)
' ---------------------------------------------------------
' Trägt die gescannte Menge eines Artikel in das Grid ein
' - Ändert die Farbe, abhängig von Gesamtmenge und Gescannte Menge
' - Überprüft, ob Artikel in der Gescannten Menge auf Lager liegt
'
' Rückgabewert: Keiner
' ---------------------------------------------------------
' Version Date: 03.12.2020
Sub UpdateArticleRow(RowNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
DebugMessage = ""
' Bereits gescannte, Gesamt und Anzahl zu Scannen auslesen
ProductNumber = Grid.GetCellValue(RowNumber, COLUMN_ARTICLENUMBER)
Total = Cint(Grid.GetCellValue(RowNumber, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(RowNumber, COLUMN_SCANNED))
ScannedAmount = Cint(amountBox.Contents)
' Aktuellen Lagerstand abfragen
StockedAmount = GetWinLineStockedAmount(ProductNumber, False)
' Neue bereits gescannte berechnen
NewScanned = Scanned + ScannedAmount
If DEBUG_ON = True Then
AddDebugLine "Total " & Total
AddDebugLine "Scanned: " & Scanned
AddDebugLine "NewScanned: " & NewScanned
AddDebugLine "StockedAmount: " & StockedAmount
ShowDebugBox "UpdateArticleRow"
End If
' Zeilenfarbe anpassen:
' GRÜN: Komplett gescannt
' GELB: Teilweise gescannt
If NewScanned > StockedAmount Then
Message = ""
Message = Message & "Der Artikel ist nur in der Menge " & StockedAmount & " vorhanden." & vbNewline
Message = Message & "Der Scan wird abgebrochen!"
Msgbox Message, vbExclamation, DEFAULT_TITLE
Elseif NewScanned = Total Then
Grid.SetLineColor RowNumber, COLOR_GREEN
Grid.SetCellValue RowNumber, COLUMN_SCANNED, NewScanned
Elseif NewScanned < Total Then
Grid.SetLineColor RowNumber, COLOR_YELLOW
Grid.SetCellValue RowNumber, COLUMN_SCANNED, NewScanned
Else
Message = ""
Message = Message & "Eingegebene Menge überschreitet die Gesamt-Anzahl oder" & vbNewline
Message = Message & "Artikel wurde bereits vollständig gescannt!"
Msgbox Message, vbExclamation, DEFAULT_TITLE
End If
End Sub

237
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/ArticleExists.vbm Normal file
View File

@@ -0,0 +1,237 @@
' ArticleExists(Identifier: String)
' ----------------------------------------------------------------------------
' Findet Artikelnummer anhand von versch. Kriterien
' - Artikel-Nummer, Alternative Artikel-Nummer, EAN-Code, Seriennummer
' - Gibt die Zeile im Grid zurück in der Artikel das erste Mal gefunden wurde
'
' Returns: ArticleExists: Int
' ----------------------------------------------------------------------------
' 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: 01.09.2020 / JJ
' Version Date / Editor: 13.12.2021 / MP
' Version Number: 3.0.0.6
Const ARTICLE_EXISTS_NO_STOCK = -99
Const ARTICLE_EXISTS_NO_SERIALNUMBER = -98
Const ARTICLE_EXISTS_NO_ARTICLE_EAN = -97
Const ARTICLE_EXISTS_NO_REGEX_MATCH = -96
Const ARTICLE_EXISTS_OVERSCANNED = -95
Function ArticleExists(Identifier)
ArticleExists = 0
HasError = False
CURRENT_SERIALNUMBER = ""
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
' ===================== SERIENNUMMER =====================
' Zuerst prüfen wir, ob es ein Seriennummerartikel ist
Set ResultSeriennummer = GetSeriennummerRow(Identifier)
If ResultSeriennummer.RowCount > 0 Then
SerialNumberString = ResultSeriennummer.Value("C068")
MainArticleNumber = ResultSeriennummer.Value("C011")
SQL = ""
SQL = SQL & "(C002 = '" & MainArticleNumber & "') "
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set ResultMainArticle = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If ResultMainArticle.RowCount > 0 Then
' Default: ART_REGEX_FLDBEZ = C222
SerialNumberPattern = ResultMainArticle.Value(ART_REGEX_FLDBEZ)
End If
If DEBUG_ON = True Then
AddDebugLine "Preparing Regex Check. " & vbNewline
AddDebugLine "SerialNumberString: " & SerialNumberString
AddDebugLine "SerialNumberPattern: " & SerialNumberPattern
AddDebugLine "MainArticleNumber: " & MainArticleNumber
ShowDebugBox "ArticleExists"
End If
If Len(SerialNumberPattern) > 0 And Len(SerialNumberString) > 0 Then
Set SerialNumberRegex = New Regexp
With SerialNumberRegex
.Pattern = SerialNumberPattern
.IgnoreCase = False
.Global = False
End With
Set RegexMatch = SerialNumberRegex.Execute(SerialNumberString)
Set FirstMatch = RegexMatch.Item(0)
If DEBUG_ON = True Then
AddDebugLine "Checked Serialnumber against Regex. (1/2)" & vbNewline
AddDebugLine "FirstMatch.Length: " & FirstMatch.Length
AddDebugLine "Len(SerialNumberString): " & Len(SerialNumberString)
AddDebugLine "FirstMatch.FirstIndex: " & FirstMatch.FirstIndex
ShowDebugBox "ArticleExists"
End If
If Not (FirstMatch.Length = Len(SerialNumberString) And FirstMatch.FirstIndex = 0) Then
ArticleExists = ARTICLE_EXISTS_NO_REGEX_MATCH
HasError = True
End If
If DEBUG_ON = True Then
AddDebugLine "Checked Serialnumber against Regex. (2/2)" & vbNewline
AddDebugLine "Result: " & SerialNumberRegex.Test(SerialNumberString)
AddDebugLine "Serialnumber: " & SerialNumberString
AddDebugLine "Regex: " & SerialNumberPattern
ShowDebugBox "ArticleExists"
End If
End If
CURRENT_SERIALNUMBER = Identifier
Set Result = ResultSeriennummer
Else
' ===================== ARTIKEL NUMMER / EAN-CODE =====================
' Wenn es kein Ausprägeartikel ist, suchen wir im Artikelstamm
Set Result = GetArticleRow(Identifier)
End If
'==========================================================
If HasError = True Then
' Just skip the rest of the function and return the current error
Elseif Result.RowCount > 0 Then
' Wir brauchen die Hauptartikelnummer, weil die Prüfung sonst bei SN-Artikeln fehlschlägt
MainArticleNumber = Result.Value("C011")
RealArticleNumber = Result.Value("C002")
AmountStocked = GetWinLineStockedAmount(RealArticleNumber, False)
If DEBUG_ON = True Then
AddDebugLine "Checking stock of product: " & RealArticleNumber & " (" & MainArticleNumber & ")" & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "Stock: " & AmountStocked
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
If AmountStocked > 0 Then
If DEBUG_ON = True Then
AddDebugLine "Amount stocked: " & AmountStocked
End If
' Vorkommen in Tabelle prüfen
For GridLineIndex = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(GridLineIndex, COLUMN_ARTICLENUMBER)
Total = Cint(Grid.GetCellValue(GridLineIndex, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(GridLineIndex, COLUMN_SCANNED))
Amount = CInt(amountBox.ScreenContents)
If CurrentArticleNumber = MainArticleNumber Then
If DEBUG_ON = True Then
AddDebugLine "CurrentArticleNumber matches MainArticleNumber! (" & CurrentArticleNumber & ")"
End If
If Total > Scanned Then
If DEBUG_ON = True Then
AddDebugLine "Product is not yet scanned completely and exists in Row " & GridLineIndex & "!"
End If
If (Total - Scanned) >= Amount Then
ArticleExists = GridLineIndex
Exit For
Else
If GetCountInDuplList(CurrentArticleNumber) <= 1 Then
Exit For
End If
End If
Else
ArticleExists = ARTICLE_EXISTS_OVERSCANNED
End If
End If
Next
Else
If DEBUG_ON = True Then
AddDebugLine "Amount stocked: 0"
End If
ArticleExists = ARTICLE_EXISTS_NO_STOCK
End If
If DEBUG_ON = True Then
ShowDebugBox "ArticleExists"
End If
Else
If CURRENT_SERIALNUMBER = "" Then
ArticleExists = ARTICLE_EXISTS_NO_ARTICLE_EAN
Else
ArticleExists = ARTICLE_EXISTS_NO_SERIALNUMBER
End If
End If
End Function
Function GetSeriennummerRow(Identifier)
Set GetSeriennummerRow = Nothing
If Len(Identifier) > 0 Then
Set Conn = CWLStart.Connection
SQL = ""
SQL = SQL & " SELECT TOP 1 C002, C011, C068 "
SQL = SQL & " FROM T024 (NOLOCK) "
SQL = SQL & " WHERE C068 = '" & Identifier & "' "
SQL = SQL & " AND c038 IS NULL " ' Nur aktive Artikel
SQL = SQL & SQLQuery_BasicWhere
Set GetSeriennummerRow = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for Article by Article serial number " & vbNewline
AddDebugLine "Result Columns: " & GetSeriennummerRow
AddDebugLine "Result Rows: " & GetSeriennummerRow.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists - GetSeriennummerRow"
End If
End If
End Function
' Ruft Daten aus der Tabelle t024 ab, für Artikel OHNE Ausprägung
Function GetArticleRow(Identifier)
Set GetArticleRow = Nothing
If Len(Identifier) > 0 Then
Set Conn = CWLStart.Connection
SQL = ""
SQL = SQL & " SELECT TOP 1 C002, C011 "
SQL = SQL & " FROM T024 (NOLOCK) "
SQL = SQL & " WHERE (C002 = '" & Identifier & "' OR C075 = '" & Identifier & "' OR C114 = '" & Identifier & "' OR C115 = '" & Identifier & "') "
SQL = SQL & " AND c038 IS NULL " ' Nur aktive Artikel
SQL = SQL & SQLQuery_BasicWhere
Set GetArticleRow = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for Article by ArticleNo/EAN-Code.. " & vbNewline & vbNewline
AddDebugLine "Result Columns: " & GetArticleRow & vbNewline
AddDebugLine "Result Rows: " & GetArticleRow.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists - GetArticleRow"
End If
End If
End Function

82
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/CheckArticleGroupIsRelevant.vbm Normal file
View File

@@ -0,0 +1,82 @@
' CheckArticleGroupIsRelevant(ArticleGroup : Integer)
' ----------------------------------------------------------------------------
' Prüft, ob die übergebene Artikelgruppe am Packtisch bearbeitet/gescannt
' werden kann (true), oder ob es sich um eine "nicht-relevante" Artikelgruppe
' handelt (false), zb Versandkosten, die auf nicht sichtbar geschaltet wird.
'
' Geprüft wird gegen die Variable EXCLUDED_ARTICLEGROUPS, die im Fensterscript
' konfiguriert werden kann.
' Die Variable kann entweder genau einen Wert, einen unteren/oberen Grenzwert
' oder eine Liste von Werten enthalten.
' Erlaubte Beispiele:
' - Genau ein Wert: "100"
' - Grenzwert bis/ab dem dies gilt: "100-" / "100+"
' - Array von verschiedenen Werten: "100, 101, 102"
'
' Wenn keine Artikelgruppe als nicht-relevant definiert wurde oder die zu
' prüfende Artikelgruppe ist leer oder kleiner 1, wird True zurückgegeben.
'
' Returns: CheckArticlegroupIsRelevant : Boolean
' ----------------------------------------------------------------------------
' 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: 24.06.2021 / MP
' Version Date / Editor: 28.06.2021 / MP
' Version Number: 3.0.0.4
Function CheckArticleGroupIsRelevant(ArticleGroup)
CheckArticleGroupIsRelevant = True
' Wenn die Variable leer ist, sind alle Artikelgruppen relevant
If Len(EXCLUDED_ARTICLEGROUPS) <= 0 Then
Exit Function
End If
' Ohne Wert geht gar nichts, auch Negative Werte sind sinnlos
If Len(ArticleGroup) <= 0 Or ArticleGroup < 0 Then
CheckArticleGroupIsRelevant = False
Exit Function
End If
' Wenn EXCLUDED_ARTICLEGROUPS ein Komma enthält, muss ein Array
' aus den Elementen erzeugt werden.
posKomma = InStr(EXCLUDED_ARTICLEGROUPS, ",")
If posKomma > 0 Then
exValueArray = Split(EXCLUDED_ARTICLEGROUPS, ",")
For Each exValue in exValueArray
If Cint(exValue) = ArticleGroup Then
CheckArticleGroupIsRelevant = False
Exit Function
End If
Next
Else
posPlus = InStr(EXCLUDED_ARTICLEGROUPS, "+")
posMinus = InStr(EXCLUDED_ARTICLEGROUPS, "-")
If posPlus > 0 Then
' + enthalten, die Variable enthält ein unteres Limit
limit = CInt(Mid(EXCLUDED_ARTICLEGROUPS, 1, posPlus-1))
If ArticleGroup >= limit Then
CheckArticleGroupIsRelevant = False
End If
ElseIf posMinus > 0 Then
' - enthalten, die Variable enthält ein oberes Limit
limit = CInt(Mid(EXCLUDED_ARTICLEGROUPS, 1, posMinus-1))
If ArticleGroup <= limit Then
CheckArticleGroupIsRelevant = False
End If
Else
' Die Variable enthält genau eine Artikelgruppe
If ArticleGroup = CInt(EXCLUDED_ARTICLEGROUPS) Then
CheckArticleGroupIsRelevant = False
End If
End If
End If
End Function

65
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/CheckMacroArticlesComplete.vbm Normal file
View File

@@ -0,0 +1,65 @@
' CheckMacroArticlesComplete()
' ----------------------------------------------------------------------------
' Prüft, ob die im Auftrag enthaltenen Macro-Artikel
' vollständig sind, und vermerkt die Infos im
' MACRO_ARTICLE_LIST-Array
'
' 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: 08.03.2021 / MP
' Version Date / Editor: 08.03.2021 / MP
' Version Number: 3.0.0.0
Sub CheckMacroArticlesComplete()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
For GridIndex = 1 To Grid.LineCount: Do
MacroFlag = Cint(Grid.GetCellValue(GridIndex, COLUMN_MACRO_FLAG))
If MacroFlag = 1 Then
LineNumber = Cint(Grid.GetCellValue(GridIndex, COLUMN_LINE_NUMBER))
MacroArticleListIndex = -1
For MacroArrayIndex = 0 To UBound(MACRO_ARTICLE_LIST)
If MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_LINE_NUMBER, MacroArrayIndex) = LineNumber Then
MacroArticleListIndex = MacroArrayIndex
Exit For
End If
Next
For InnerGridIndex = GridIndex + 1 To Grid.LineCount: Do
InnerMacroFlag = Cint(Grid.GetCellValue(InnerGridIndex, COLUMN_MACRO_FLAG))
If InnerMacroFlag = 2 Then
AmountTotal = Cint(Grid.GetCellValue(InnerGridIndex, COLUMN_TOTAL))
AmountScanned = Cint(Grid.GetCellValue(InnerGridIndex, COLUMN_SCANNED))
If AmountTotal <> AmountScanned Then
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_GRID_LINE_INDEX, MacroArticleListIndex) = GridIndex
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_COMPLETE, MacroArticleListIndex) = False
' An der Stelle des unvollständigen Artikels weiter prüfen
GridIndex = InnerGridIndex
' Aus Makroartikel aussteigen, weil unvollständig
Exit For
End If
Else
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_GRID_LINE_INDEX, MacroArticleListIndex) = GridIndex
' An der Stelle des unvollständigen Artikels weiter prüfen
GridIndex = InnerGridIndex
' Aus Makroartikel aussteigen, weil vollständig
Exit For
End If
Loop While False: Next
Else
' Nächsten Artikel bearbeiten
Exit Do
End If
Loop While False: Next
End Sub

51
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/CheckOrderIsLocked.vbm Normal file
View File

@@ -0,0 +1,51 @@
' CheckOrderIsLocked(OrderNumber : String)
' ----------------------------------------------------------------------------
' Prüft, ob der Auftrag gesperrt ist.
' Wenn der Auftrag gesperrt ist, wird der Anwender informiert,
' wer die Sperre hält, und ob man es erneut versuchen möchte,
' oder Abbrechen will. Das Verhalten orientiert sich an der
' Vorlage, wie die Winline auf solche Sperrren reagiert.
'
' Returns: CheckOrderIsLocked : Boolean
' ----------------------------------------------------------------------------
' 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: 07.04.2021 / MP
' Version Date / Editor: 07.04.2021 / MP
' Version Number: 3.0.0.2
Function CheckOrderIsLocked(OrderNumber)
CheckOrderIsLocked = False
If Len(OrderNumber) <= 0 Then
' Ohne Auftrag geht gar nichts
Exit Function
End If
Dim ContinueFlag : ContinueFlag = True
Do
UserId = IsOrderLocked(OrderNumber)
If UserId > 0 Then
CheckOrderIsLocked = True ' Rückgabewert
QuestionText = "Der Auftrag [" & OrderNumber & "] wird von Benutzr [" & GetWinLineUserData(UserID) & "] bearbeitet! " & vbNewLine & vbNewLine
Answer = MsgBox(QuestionText & "Wollen Sie abbrechen?", vbYesno + vbQuestion, DEFAULT_TITLE & " - CheckOrderIsLocked")
If Answer = vbYes Then
ContinueFlag = False ' Abbrechen
Else
ContinueFlag = True ' Weiter prüfen
End If
Else
CheckOrderIsLocked = False ' Rückgabewert
ContinueFlag = False
End If
Loop While ContinueFlag = true
End Function

360
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/CompleteOrder.vbm Normal file
View File

@@ -0,0 +1,360 @@
' CompleteOrder()
' ----------------------------------------------------------------------------
' Schließt die Prüfung ab und erstellt einen Lieferschein
'
' Returns: CompleteOrder : Boolean
' ----------------------------------------------------------------------------
' 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: 01.09.2020 / JJ
' Version Date / Editor: 27.07.2022 / JJ/MP
' Version Number: 3.0.0.7
Function CompleteOrder()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Conn = CWLStart.CurrentCompany.Connection
Set Grid = mywin.Controls.Item(GRID_ID).Grid
If MACRO_ARTICLE_COUNTER > 0 Then
Dim MacroArticleReseted : MacroArticleReseted = False
CheckMacroArticlesComplete()
For MacroArrayIndex = 0 To Ubound(MACRO_ARTICLE_LIST, 2)
If (MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_COMPLETE, MacroArrayIndex) = False) AND _
(MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_SCAN_FLAG, MacroArrayIndex) = True) Then
questionText = "Der Package-Artikel [" & MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_NUMBER, MacroArrayIndex) & "] ist unvollständig!" & vbNewLine & vbNewLine
Answer = MsgBox(questionText & "Soll das gesamte Package zurückgesetzt werden?", vbYesno + vbQuestion, DEFAULT_TITLE)
If Answer = vbYes Then
ResetValuesByMacroLineNumber MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_LINE_NUMBER, MacroArrayIndex)
MacroArticleReseted = True
Else
CompletedPackages = Cint(InputBox("Wieviele Package-Artikel von insgesamt [" & MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_REMAINING, MacroArrayIndex) & "] werden damit ausgeliefert?", "Anzahl fertige Packages", "0"))
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED, MacroArrayIndex) = CompletedPackages
End If
End If
If (MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_COMPLETE, MacroArrayIndex) = True) Then
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED, MacroArrayIndex) = MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_REMAINING, MacroArrayIndex)
End If
Next
If MacroArticleReseted = True Then
Answer = MsgBox("Einer oder mehrere Package-Artikel wurden zurückgesetzt. Soll die Lieferscheinerstellung abgebrochen werden?", vbYesno + vbQuestion, DEFAULT_TITLE)
If Answer = vbYes Then
CompleteOrder = False
Exit Function
End If
End If
' Übertrage Macro-Daten zurück ins Grid
TransferMacroData()
End If
' Übertrage die Grid-Daten zurück in die Order-Datenstruktur
TransferGridData()
' Eine letzte Möglichkeit die Auftragsdaten zu tunen
UpdateOrderDataBeforeDelNote()
Dim OrderId, AccountSQL, MandatorId, RunningNumber
If DEBUG_ON = True Then
AddDebugLine "Completing order.. " & vbNewline
ShowDebugBox "CompleteOrder"
End If
OrderId = mywin.Controls.Item(ORDER_INPUT).ScreenContents
AccountSQL = "SELECT DISTINCT c021 FROM t025 (NOLOCK) WHERE c044 = '" & OrderId & "' " & SQLQuery_OrderWhere
Set AccountResult = Connection.Select(AccountSQL)
If DEBUG_ON = True Then
AddDebugLine "Querying for CustomerAccountId.. " & vbNewline
AddDebugLine "Result Columns: " & AccountResult
AddDebugLine "Result Rows: " & AccountResult.RowCount
AddDebugLine "SQL: " & AccountSQL
ShowDebugBox "CompleteOrder"
End If
MandatorId = AccountResult.Value("c021")
RunningNumber = RUNNING_NUMBER_PREFIX & OrderId
BelegKey = Cstr(DateDiff("s", "01/01/1970 00:00:00", Now))
' ===================== KOPFDATEN =====================
Dim Request, URL, XML
Dim NowObject : NowObject = Now
Dim DateString : DateString = Year(NowObject) & "-" & GetLeftPad(Month(NowObject)) & "-" & GetLeftPad(Day(NowObject))
Dim TimeString : TimeString = GetLeftPad(Hour(NowObject)) & ":" & GetLeftPad(Minute(NowObject)) & ":" & GetLeftPad(Second(NowObject))
Dim UserNumber : UserNumber = Cwlstart.Currentuser.Number
Dim ComputerName : ComputerName = GetWindowsEnvironment("COMPUTERNAME")
' === WEB SERVICES =======================
XML = ""
XML = XML & "<?xml version=""1.0"" encoding=""UTF-8""?>"
XML = XML & "<MESOWebService TemplateType=""__TYPE__"" Template=""__VORLAGE__"" option=""__OPTION__"" printVoucher=""__PRINT__"">"
XML = XML & "<__VORLAGE__T025>"
XML = XML & "<BELEGKEY>" & BelegKey & "</BELEGKEY>"
XML = XML & "<Kontonummer>" & MandatorId & "</Kontonummer>"
XML = XML & "<Laufnummer>" & RunningNumber & "</Laufnummer>"
XML = XML & "<Auftragsnummer>" & OrderId & "</Auftragsnummer>"
XML = XML & "<Datum_Lieferschein>" & DateString & "</Datum_Lieferschein>"
If USE_ADDITIONAL_DBFIELDS = True Then
XML = XML & "<BenutzerNummerPacktisch>" & UserNumber & "</BenutzerNummerPacktisch>"
XML = XML & "<ErstellDatumPacktisch>" & DateString & " " & TimeString & "</ErstellDatumPacktisch>"
XML = XML & "<ComputerNamePacktisch>" & ComputerName & "</ComputerNamePacktisch>"
XML = XML & "<VersionPacktisch>" & PACKTISCH_VERSION & "</VersionPacktisch>"
End If
XML = XML & "</__VORLAGE__T025>"
' === EXIM TABELLE =======================
HeadSQL = "INSERT INTO " & SQLDB_for_EXIM & "." & SQLHeadTB_for_EXIM & " "
HeadSQL = HeadSQL & "(BELEGKEY, Kontonummer, Laufnummer, Auftragsnummer, Belegdatum) "
HeadSQL = HeadSQL & "VALUES("& BelegKey &", '"& MandatorId &"', '"& RunningNumber &"', '"& OrderId &"', GETDATE())"
HeadResult = Conn.ExecuteSQL(HeadSQL)
If DEBUG_ON = True Then
AddDebugLine "Inserting Head Data" & vbNewline
AddDebugLine "Result: " & HeadResult
AddDebugLine "SQL: " & HeadSQL
ShowDebugBox "CompleteOrder"
End If
' ===================== ENDE KOPFDATEN =====================
' ============================ MITTEDATEN ============================
Dim ArticleNumber, AmountScanned, SerialNumber, StorageLocation, LineNumber
For OrderArrayIndex = 0 To Ubound(ORDER_ARTICLE_DATA, 2): Do
IsSerialNumberArticle = Cint(ORDER_ARTICLE_DATA(INDEX_IS_SERIAL_NUMBER, OrderArrayIndex))
ArticleNumber = ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex)
SerialNumber = ORDER_ARTICLE_DATA(INDEX_SERIAL_NUMBER, OrderArrayIndex)
AmountScanned = CInt(ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex))
LineNumber = CInt(ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex))
DataType = CInt(ORDER_ARTICLE_DATA(INDEX_DATA_TYPE, OrderArrayIndex))
VKPreisEinzel = Replace(ORDER_ARTICLE_DATA(INDEX_PRICE_VK_EINZEL, OrderArrayIndex), ",", ".")
IsOpen = ORDER_ARTICLE_DATA(INDEX_IS_OPEN, OrderArrayIndex)
' Sonderfall Artikel mit negativen Mengen
If (ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) - ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex)) < 0 Then
AmountScanned = ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex)
IsOpen = True
End If
' Sonderfall - Artikel aus nicht-relevanter Artikelgruppe hat Nachkommastellen (z.B. Zeit)
If CheckArticleGroupIsRelevant(ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex)) = False Then
AmountOrdered = ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex)
AmountDelivered = ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex)
AmountScanned = AmountOrdered - AmountDelivered
AmountScanned = Replace(AmountScanned, ",", ".")
End If
If DEBUG_ON = True Then
AddDebugLine "Processing Article: " & ArticleNumber
AddDebugLine "SerialNumber: " & SerialNumber
AddDebugLine "LineNumber: " & LineNumber
AddDebugLine "DataType: " & DataType
AddDebugLine "IsOpen: " & IsOpen
ShowDebugBox "CompleteOrder"
End If
' Text-Artikel werden nicht übergeben
If DataType = 3 Then
Exit Do
End If
If PRINT_DOCUMENT_AFTER_COMPLETION = True Then
StorageLocation = GetWinLineStorageLocation(ArticleNumber, SerialNumber, IsSerialNumberArticle)
InternalArticleNumber = GetWinLineInternalProductNumber(ArticleNumber, SerialNumber)
Else
StorageLocation = 0
InternalArticleNumber = 0
End If
' === EXIM TABELLE =======================
MidSQL = "INSERT INTO " & SQLDB_for_EXIM & "." & SQLMiddleTB_for_EXIM & " "
MidSQL = MidSQL & "(BELEGKEY, Artikelnummer, Hauptartikelnummer, Zeilennummer, Datentyp, Mengegeliefert, ChargeIdentnummer, Lagerort, Einzelpreis) "
MidSQL = MidSQL & "VALUES (" & BelegKey & ", '" & ArticleNumber & "', '" & ArticleNumber & "', "
If IsSerialNumberArticle = 1 Then
MidSQL = MidSQL & LineNumber
Else
MidSQL = MidSQL & " NULL"
End If
MidSQL = MidSQL & ", '1', " & AmountScanned & ", '" & SerialNumber & "', " & StorageLocation& ", " & VKPreisEinzel & ")"
MidResult = Conn.ExecuteSQL(MidSQL)
' === WEB SERVICES =======================
MidXML = ""
' Abgeschlossene Belegzeilen werden nicht an den WebSerivce übergeben
If IsOpen = True Then
MidXML = MidXML & "<__VORLAGE__T026>"
MidXML = MidXML & "<BELEGKEY>" & BelegKey & "</BELEGKEY>"
MidXML = MidXML & "<Artikelnummer>" & InternalArticleNumber & "</Artikelnummer>"
MidXML = MidXML & "<Hauptartikelnummer>" & ArticleNumber & "</Hauptartikelnummer>"
MidXML = MidXML & "<Zeilennummer>" & LineNumber & "</Zeilennummer>"
MidXML = MidXML & "<Datentyp>" & "1" & "</Datentyp>"
MidXML = MidXML & "<Mengegeliefert>" & AmountScanned & "</Mengegeliefert>"
MidXML = MidXML & "<ChargeIdentnummer>" & SerialNumber & "</ChargeIdentnummer>"
MidXML = MidXML & "<Lagerort>" & StorageLocation & "</Lagerort>"
MidXML = MidXML & "<Einzelpreis>" & VKPreisEinzel & "</Einzelpreis>"
MidXML = MidXML & "</__VORLAGE__T026>"
End If
If DEBUG_ON = True Then
AddDebugLine "Inserting Middle Data" & vbNewline
AddDebugLine "For Article " & ArticleNumber
AddDebugLine "And Amount " & AmountScanned
AddDebugLine "Result: " & MidResult & vbNewline
AddDebugLine "SQL: " & MidSQL & vbNewline
AddDebugLine "XML: " & MidXML
ShowDebugBox "CompleteOrder"
End If
XML = XML & MidXML
Loop While False: Next
XML = XML & "</MESOWebService>"
XML = Replace(XML, "__VORLAGE__", WEB_VORLAGE)
XML = Replace(XML, "__TYPE__", WEB_TYPE)
XML = Replace(XML, "__PRINT__", WEB_PRINT)
XML = Replace(XML, "__OPTION__", WEB_OPTION)
If USE_WEBSERVICE_WITH_FILES = True Then
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
BasePath = CWLStart.CurrentCompany.Value(MDFLDNO_MODULE_PATH)
FileName = BelegKey & ".xml"
AbsoluteImportPath = BasePath & "\..\" & RELATIVE_IMPORT_PATH
AbsoluteImportPath = CreateDateDirectory(AbsoluteImportPath)
RelativeImportFilePath = RELATIVE_IMPORT_PATH & "\" & GetRelativDateDirectoryName() & "\" & FileName
AbsoluteImportFilePath = AbsoluteImportPath & "\" & FileName
If DEBUG_ON = True Then
AddDebugLine "Creating Absolute Path"
AddDebugLine "AbsoluteImportPath: " & AbsoluteImportPath
AddDebugLine "RelativeImportFilePath: " & RelativeImportFilePath
AddDebugLine "AbsoluteImportFilePath: " & AbsoluteImportFilePath
ShowDebugBox "CompleteOrder"
End If
If FSO.FolderExists(AbsoluteImportPath) = False Then
MsgBox("Import Pfad [" & AbsoluteImportPath & "] existiert nicht. Import wird abgebrochen.")
CompleteOrder = False
Exit Function
End If
Set OutPutFile = FSO.OpenTextFile(AbsoluteImportFilePath, 2, True)
OutPutFile.WriteLine(XML)
If DEBUG_ON = True Then
AddDebugLine "Writing XML File:"
AddDebugLine "SUCCESS"
ShowDebugBox "CompleteOrder"
End If
Set FSO = Nothing
' Import mit Datei
WEB_BYREF = 1
WEB_DATA = RelativeImportFilePath
Else
' Import per URL
WEB_BYREF = 0
WEB_DATA = XML
End If
URL = "http://__SERVER__/ewlservice/import?User=__USER__&Password=__PASSWORD__&Company=__COMPANY__&Type=30&Vorlage=__VORLAGE__&Actioncode=__ACTIONCODE__&byref=__BYREF__&Data=__DATA__"
URL = Replace(URL, "__SERVER__", WEB_SERVER)
URL = Replace(URL, "__USER__", WEB_USER)
URL = Replace(URL, "__PASSWORD__", WEB_PASS)
URL = Replace(URL, "__COMPANY__", WEB_COMPANY)
URL = Replace(URL, "__VORLAGE__", WEB_VORLAGE)
URL = Replace(URL, "__BYREF__", WEB_BYREF)
URL = Replace(URL, "__ACTIONCODE__", WEB_ACTIONCODE)
URL = Replace(URL, "__DATA__", WEB_DATA)
If DEBUG_ON = True Then
AddDebugLine "Sending Request to WebServices.."
AddDebugLine "URL: " & URL
AddDebugLine "WEB_PRINT: " & WEB_PRINT
AddDebugLine "WEB_OPTION: " & WEB_OPTION
ShowDebugBox "CompleteOrder"
End If
' ======================= ENDE MITTEDATEN =======================
If PRINT_DOCUMENT_AFTER_COMPLETION = True Then
' ===================== HTTP REQUEST =====================
Set Request = CreateObject("MSXML2.XMLHTTP")
Request.Open "POST", URL, False
Request.Send
Response = Request.ResponseText
Status = Request.Status
If DEBUG_ON = True Then
AddDebugLine "Response from WebServices!"
AddDebugLine "Status: " & Status
AddDebugLine "Body: " & Response
ShowDebugBox "CompleteOrder"
End If
' =================== ENDE HTTP REQUEST ==================
Error = False
Message = ""
If Status = 200 Then
If TestIsWebserviceResponseSuccessful(Response) = True Then
Message = "Lieferschein wurde übertragen!"
Else
Error = True
Message = "Lieferschein wurde nicht übertragen! Fehlerdetails: " & vbNewline & vbNewline & Response
End If
Else
Error = True
Message = "Fehler beim Zugriff auf Webservices aufgetreten!" & vbNewline & vbNewline & "Status: " & Status
End If
If Error = False Then
MsgBox Message, vbInformation, DEFAULT_TITLE
CompleteOrder = True
Else
MsgBox Message, vbExclamation, DEFAULT_TITLE & " - Fehler bei Abschluss"
CompleteOrder = False
End If
Else
CompleteOrder = True
End If
End Function

35
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/CountRowsForArticle.vbm Normal file
View File

@@ -0,0 +1,35 @@
' CountRowsForArticle(ArticleNumber : String)
' ----------------------------------------------------------------------------
' Gibt die Anzahl der Zeilen zu einer Artikelnummer zurück
'
' Returns: CountRowsForArticle : Int
' ----------------------------------------------------------------------------
' 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: 25.09.2020 / JJ
' Version Date / Editor: 25.09.2020 / JJ
' Version Number: 1.0.0.0
Function CountRowsForArticle(ArticleNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Dim Count : Count = 0
If DEBUG_ON = True Then
AddDebugLine "Counting rows for Article: " & ArticleNumber
ShowDebugBox "CountRowsForArticle"
End If
For GridIndex = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(GridIndex, COLUMN_ARTICLENUMBER)
If ArticleNumber = CurrentArticleNumber Then
Count = Count + 1
End If
Next
CountRowsForArticle = Count
End Function

392
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/DuplicateArticles.vbm Normal file
View File

@@ -0,0 +1,392 @@
' DuplicateArticles (ArticleNumber : String, MacroFlag : Int, ChargeFlag : Int)
' ----------------------------------------------------------------------------
' Funktionen zur Behandlung mehrfach vorkommender
' Artikelnummern. Daten werden im Array DUPL_ARTICLE_LIST
' gespeichert und verwaltet.
'
' 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: 15.04.2021 / MP
' Version Date / Editor: 15.04.2021 / MP
' Version Number: 3.0.0.2
Const ARTICLE_IS_NOT_IN_DUPLICATES_LIST = -199
Const GRIDLINE_INDEX_IS_NOT_CHOOSEABLE = -198
Const NO_GRIDLINE_INDEX_CHOSEN = -197
CONST USE_ORIGINAL_ROW = -196
' Legt für jeden scannbaren Artikel einen Satz in der Duplikate-Struktur an
' und zählt wie oft dieser Artikel vorkommt.
' Für Artikel innerhalb eines Macros wird zusätzlich ein eigener Zähler hochgesetzt.
Sub AddArticleNumberToDuplList(ArticleNumber, MacroFlag, ChargeFlag)
DuplArrayIndex = ExistArticleInDuplList(ArticleNumber)
If DuplArrayIndex = ARTICLE_IS_NOT_IN_DUPLICATES_LIST Then
' Lege neue Zeile an
AddTwoDimArrayRow DUPL_ARTICLE_LIST
DuplArrayIndex = UBound(DUPL_ARTICLE_LIST, 2)
DUPL_ARTICLE_LIST(COLUMN_DUPL_ARTICLE_NUMBER, DuplArrayIndex) = ArticleNumber
DUPL_ARTICLE_LIST(COLUMN_DUPL_CHARGE_FLAG, DuplArrayIndex) = ChargeFlag
DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex) = 1
DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex) = 0
If (MacroFlag = 2) Then
DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex) = 1
End If
DUPL_ARTICLE_LIST(COLUMN_DUPL_GRID_LINE_INDEXE, DuplArrayIndex) = ""
Else
' Erhöhe Wert in bestehender Zeile
currentValue = DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex)
DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex) = currentValue + 1
If (MacroFlag = 2) Then
currentMacroValue = DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex)
DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex) = currentMacroValue + 1
End If
End If
End Sub
' Reduziert die Zähler für den Artikel, wenn eine Zeile vollständig gescannt wurde.
' Für Macro-Unterteile wird zusätzlich der MacroCounter reduziert
Sub ReduceCounterInDuplList(ArticleNumber, MacroFlag)
DuplArrayIndex = ExistArticleInDuplList(ArticleNumber)
If DuplArrayIndex >= 0 Then
' Vermindert Wert für den Artikel
currentValue = DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex)
DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex) = currentValue - 1
If (MacroFlag = 2) Then
currentMacroValue = DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex)
DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex) = currentMacroValue - 1
End If
End If
End Sub
' Reduziert die Zähler im Sub-Macro-Artikel-Token, wenn eine Zeile vollständig gescannt wurde.
' benötigt die ZeilenNummer des Macro Artikels
Sub ReduceSubMacroCounterInDuplList(ArticleNumber, MacroLineNumber)
DuplArrayIndex = ExistArticleInDuplList(ArticleNumber)
If DuplArrayIndex >= 0 Then
TestToken = "#" & MacroLineNumber & ","
CurrentMacroLineNumbers = DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_LINE_NUMBERS, DuplArrayIndex)
If Len(CurrentMacroLineNumbers) > 0 And InStr(CurrentMacroLineNumbers, TestToken) > 0 Then
'Counter reduzieren!
TempMacroLineNumbers = ""
SplittedTokens = Split(CurrentMacroLineNumbers)
For Each Token In SplittedTokens
If (InStr(Token, TestToken) > 0) Then
'Treffer, Counter auslesen, erhöhen und zurückschreiben
TempToken = Split(Token, ",")
TokenLen = Len(TempToken(1))-1
NewCount = CInt(Left(TempToken(1), TokenLen)) - 1
If NewCount > 0 Then
TempMacroLineNumbers = TempMacroLineNumbers & " " & TestToken & NewCount & "#"
End If
Else
' Kein Treffer, Token wieder zurückschreiben
TempMacroLineNumbers = TempMacroLineNumbers & " " & Token
End If
Next
CurrentMacroLineNumbers = TempMacroLineNumbers
End If
DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_LINE_NUMBERS, DuplArrayIndex) = CurrentMacroLineNumbers
End If
End Sub
' Ergänzt die GridLine-Indexe für Artikel, die mehrfach vorkommen
' Bedingung: Der Artikel muss bereits in der Duplicate-Struktur
' enthalten sein, und einen Counter > 1 haben.
Sub AddGridLineIndexToDuplicateArticles(ArticleNumber, GridLineIndex)
DuplArrayIndex = ExistArticleInDuplList(ArticleNumber)
If DuplArrayIndex >= 0 Then
DuplCount = DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex)
If DuplCount > 1 Then
CurrentGridLineIndexe = DUPL_ARTICLE_LIST(COLUMN_DUPL_GRID_LINE_INDEXE, DuplArrayIndex)
If Len(CurrentGridLineIndexe) > 0 Then
CurrentGridLineIndexe = CurrentGridLineIndexe & " " & FormatNumber(GridLineIndex, 0)
Else
CurrentGridLineIndexe = FormatNumber(GridLineIndex, 0)
End If
DUPL_ARTICLE_LIST(COLUMN_DUPL_GRID_LINE_INDEXE, DuplArrayIndex) = CurrentGridLineIndexe
End If
End If
End Sub
' Ergänzt die LineNumber der Macro-Hauptartikel für Macro-Sub-Artikel
' Gesammelt werden Tokens in der Form #LN,1#, wenn sie noch nicht vorkommen.
' Der Counter wird hochgezählt, um das Vorkommen des Artikels in verschiedenen Macros abzufangen
' Bedingung: Der Artikel muss bereits in der Duplicate-Struktur
' enthalten sein, und einen Counter > 1 haben.
Sub AddMacroLineNumberTokensToDuplicateArticles(ArticleNumber, MacroLineNumber)
DuplArrayIndex = ExistArticleInDuplList(ArticleNumber)
If DuplArrayIndex >= 0 Then
DuplCount = DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex)
If DuplCount > 1 Then
TestToken = "#" & MacroLineNumber & ","
CurrentMacroLineNumbers = DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_LINE_NUMBERS, DuplArrayIndex)
If Len(CurrentMacroLineNumbers) <= 0 Then
CurrentMacroLineNumbers = TestToken & "1#"
ElseIf InStr(CurrentMacroLineNumbers, TestToken) = 0 Then
CurrentMacroLineNumbers = CurrentMacroLineNumbers & " " & TestToken & "1#"
Else
'Counter erhöhen!
TempMacroLineNumbers = ""
SplittedTokens = Split(CurrentMacroLineNumbers)
For Each Token In SplittedTokens
If (InStr(Token, TestToken) > 0) Then
'Treffer, Counter auslesen, erhöhen und zurückschreiben
TempToken = Split(Token, ",")
TokenLen = Len(TempToken(1))-1
NewCount = CInt(Left(TempToken(1), TokenLen)) + 1
TempMacroLineNumbers = TempMacroLineNumbers & " " & TestToken & NewCount & "#"
Else
' Kein Treffer, Token wieder zurückschreiben
TempMacroLineNumbers = TempMacroLineNumbers & " " & Token
End If
Next
CurrentMacroLineNumbers = TempMacroLineNumbers
End If
DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_LINE_NUMBERS, DuplArrayIndex) = CurrentMacroLineNumbers
End If
End If
End Sub
' Prüfe, ob eine Artikelnummer bereits in dem Array enthalten ist
' oder nicht
' Rueckgabewert: Index des Artikels im Array, wenn bereits vorhande, sonst -1 falls nicht vorhanden
Function ExistArticleInDuplList(ArticleNumber)
ExistArticleInDuplList = ARTICLE_IS_NOT_IN_DUPLICATES_LIST
If (UBound(DUPL_ARTICLE_LIST, 2) > -1) Then
For DuplArrayIndex = 0 To UBound(DUPL_ARTICLE_LIST, 2)
If (DUPL_ARTICLE_LIST(COLUMN_DUPL_ARTICLE_NUMBER, DuplArrayIndex) = ArticleNumber) Then
ExistArticleInDuplList = DuplArrayIndex
Exit For
End If
Next
End If
End Function
' Zählt die MacroLineNumber-Tokens für den Artikel, und gibt
' die Anzahl zurück
Function GetMacroLineNumberCount(DuplArrayIndex)
Count = 0
SplittetTokens = Split(Trim(DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_LINE_NUMBERS, DuplArrayIndex)))
For Each Element In SplittetTokens
Count = Count + 1
Next
GetMacroLineNumberCount = Count
End Function
' Die Funktion gibt die Anzahl der Vorkommen des Artikels zurück.
' Für Macro-Sub-Artikel wird noch der Macro-Counter ausgewertet
Function GetCountInDuplList(ArticleNumber)
GetCountInDuplList = 0
For DuplArrayIndex = 0 To UBound(DUPL_ARTICLE_LIST, 2)
If (DUPL_ARTICLE_LIST(COLUMN_DUPL_ARTICLE_NUMBER, DuplArrayIndex) = ArticleNumber) Then
' COLUMN_DUPL_ROW_COUNT enthält die Gesamtzahl der Vorkommen
DuplCounter = DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex)
If (DuplCounter > 1) Then
' Wenn mehr als 1 Zeile übrig ist und es ein SN-Artikel ist, müssen wir genauer prüfen,
' ob wir die Auswahlbox anzeigen sollen.
ChargeFlag = DUPL_ARTICLE_LIST(COLUMN_DUPL_CHARGE_FLAG, DuplArrayIndex)
If (ChargeFlag = 2) Then
' Gibt es noch SN-Artikel in Makros? und in wievielen unterschiedlichen Macros?
macroRowCounter = cint(DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex)) ' Anzahl Artikel innerhalb von Macros
macroLineCounter = cint(GetMacroLineNumberCount(DuplArrayIndex)) ' Anzahl unterschiedlicher Macros
' Die Abfragebox muss kommen, wenn
' a) SN-Artikel in mehreren unterschiedlichen Macros vorkommen
' b) SN-Artikel innerhalb und ausserhalb von Macros vorkommen
' --> Wir geben die komplette Menge DuplCounter zurück!
' Die Box darf nicht kommen, wenn
' c) wenn SN-Artikel nur ausserhalb von Macros vorkommen
' d) SN-Artikel nur noch in einem Bereich auftauchen,
' --> Wir geben 1 als DuplCounter zurück!
If (macroLineCounter = 0 OR _
(macroLineCounter = 1 AND DuplCounter = macroRowCounter)) Then
DuplCounter = 1
End If
End If
End If
GetCountInDuplList = DuplCounter
Exit For
End If
Next
End Function
' Funktion, die die gewählte Auswahl der InputBox auswertet
' Rückgabewert: gewählte Zeilennummer oder Fehler
Function ChooseGridLineIndexFromDuplicates(ArticleNumber)
NoValidIndexSelected = True
ChooseGridLineIndexFromDuplicates = -1
Do
RetValue = ShowDuplicateInputBox(ArticleNumber)
If RetValue = ARTICLE_IS_NOT_IN_DUPLICATES_LIST Then
' Der Artikel kommt nicht im Array vor. Abbruch.
NoValidIndexSelected = False
ChooseGridLineIndexFromDuplicates = -1
ElseIf RetValue = USE_ORIGINAL_ROW Then
' Verwende einfach die schon gefundene Zeile
NoValidIndexSelected = False
ChooseGridLineIndexFromDuplicates = USE_ORIGINAL_ROW
ElseIf RetValue = NO_GRIDLINE_INDEX_CHOSEN Then
' Leere Auswahl oder Abbruch - OK
Answer = MsgBox("Wollen Sie die Scanergebnisse für Artikel [" & ArticleNumber & "] wirklich verwerfen?", vbYesno + vbQuestion, DEFAULT_TITLE)
If Answer = vbYes Then
NoValidIndexSelected = False
ChooseGridLineIndexFromDuplicates = -1
End If
ElseIf RetValue > 0 Then
' Gültiger Wert wurde ausgewählt
NoValidIndexSelected = False
ChooseGridLineIndexFromDuplicates = RetValue
Else
' Falsche Auswahl - Erneut die InputBox anzeigen.
MsgBox "Die gewählte Zeile steht nicht zur Auswahl. Bitte wählen Sie erneut.", vbOKOnly + vbExclamation, DEFAULT_TITLE
End If
Loop While NoValidIndexSelected
End Function
' Die Funktion zeigt eine InputBox mit den Informationen über
' doppelte Artikel.
' Rückgabewert: GridLineIndex der Position die bebucht werden soll
Function ShowDuplicateInputBox(ArticleNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
ScannedAmount = Cint(amountBox.Contents)
DuplArrayIndex = ExistArticleInDuplList(ArticleNumber)
If (DuplArrayIndex < 0) Then
ShowDuplicateInputBox = ARTICLE_IS_NOT_IN_DUPLICATES_LIST
Exit Function
End If
ChargeFlag = DUPL_ARTICLE_LIST(COLUMN_DUPL_CHARGE_FLAG, DuplArrayIndex)
If ChargeFlag = 2 Then
' Anzeige für SN-Artikel macht nur Sinn, wenn Macro-Artikel involviert sind.
If DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex) <= 0 Then
ShowDuplicateInputBox = USE_ORIGINAL_ROW
Exit Function
End If
End If
Dim ChooseableTokens : ChooseableTokens = "" 'Enthält die erlaubten Werte für die Auswahl
Dim AlreadyUsedAreasTokens : AlreadyUsedAreasTokens = "" ' #0# = Normaler Artikel, sonst MacroLineIndex
Dim InputTitle : InputTitle = DEFAULT_TITLE & " - Auswahl einer Zeilennummer"
Dim InputDefault : InputDefault = "" ' Hier machen wir bewusst nichts!
InputPrompt = "Der Artikel [" & ArticleNumber & "] kommt mehrfach im Auftrag vor: " & vbNewLine & vbNewLine
SplittetValues = Split(DUPL_ARTICLE_LIST(COLUMN_DUPL_GRID_LINE_INDEXE, DuplArrayIndex))
For Each GridLineIndex In SplittetValues : Do
Total = Cint(Grid.GetCellValue(Cint(GridLineIndex), COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(Cint(GridLineIndex), COLUMN_SCANNED))
Amount = Total - Scanned
If (Amount > 0) Then
MacroFlag = Cint(Grid.GetCellValue(Cint(GridLineIndex), COLUMN_MACRO_FLAG))
If (ChargeFlag = 0) Then
' Normale Artikel
ChooseableTokens = ChooseableTokens & " #" & GridLineIndex & "# "
InputPrompt = InputPrompt & "Zeile " & GridLineIndex & vbTab & " - Menge " & Amount
If MacroFlag = 2 Then
InputPrompt = InputPrompt & " (Package)"
End If
InputPrompt = InputPrompt & vbNewLine
Else
' SN-Artikel / Späte Ausprägungen
' Hier muss entschieden werden, ob ein Satz überhaupt angezeigt werden soll
MacroLineNumberToken = "#" & Grid.GetCellValue(Cint(GridLineIndex), COLUMN_MACRO_LINE_NUMBER) & "#"
If (InStr(AlreadyUsedAreasTokens, MacroLineNumberToken) = 0) Then
AlreadyUsedAreasTokens = AlreadyUsedAreasTokens & " " & MacroLineNumberToken
ChooseableTokens = ChooseableTokens & " #" & GridLineIndex & "# "
InputPrompt = InputPrompt & "Zeile " & GridLineIndex & vbTab & " - Menge " & Amount
If MacroFlag = 2 Then
InputPrompt = InputPrompt & " (Package)"
End If
InputPrompt = InputPrompt & vbNewLine
Else
Exit Do
End If
End If
End If
Loop While False: Next
InputPrompt = InputPrompt & vbNewLine & "Auf welche Zeile soll die gescannte Menge [" & ScannedAmount & "] gebucht werden?"
inputBoxValue = InputBox(InputPrompt, InputTitle, InputDefault)
Select Case True
Case IsEmpty(inputBoxValue)
' Abbruchbutton der InputBox geklickt
ShowDuplicateInputBox = NO_GRIDLINE_INDEX_CHOSEN
Case "" = Trim(inputBoxValue)
' Kein Wert eingegeben und OK geklickt
ShowDuplicateInputBox = NO_GRIDLINE_INDEX_CHOSEN
Case Else
' Wert eingegeben und OK geklickt
testToken = "#" & inputBoxValue & "#"
If (InStr(ChooseableTokens, testToken) > 0) Then
' Alles Rotscha in Kambodscha!
ShowDuplicateInputBox = inputBoxValue
Else
' Ungültiger Wert
ShowDuplicateInputBox = GRIDLINE_INDEX_IS_NOT_CHOOSEABLE
End If
End Select
End Function

48
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/GetArticleNumberFromSecondaryIndentifier.vbm Normal file
View File

@@ -0,0 +1,48 @@
' GetArticleNumberFromSecondaryIndentifier(Identifier : String)
' ----------------------------------------------------------------------------
' Gibt die Artikelnummer für Spät-Auspräge-Artikel zurück
'
' Returns: GetArticleNumberFromSecondaryIndentifier : String
' ----------------------------------------------------------------------------
' 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: 23.10.2020 / JJ
' Version Date / Editor: 23.11.2020 / JJ
' Version Number: 1.0.0.0
Function GetArticleNumberFromSecondaryIndentifier(Identifier)
SQL = ""
' EAN-Code / Alternative Artikelnummer 1 / Alternative Artikelnummer 2 / Artikelnummer / S/N
SQL = SQL & "("
SQL = SQL & "(C002 = '" & Identifier & "') Or "
SQL = SQL & "(C068 = '" & Identifier & "') Or "
SQL = SQL & "(C075 = '" & Identifier & "') Or "
SQL = SQL & "(C114 = '" & Identifier & "') Or "
SQL = SQL & "(C115 = '" & Identifier & "')"
SQL = SQL & ") "
' Nur Nach Hauptartikel/Ausprägungs(kind)artikel suchen
' SQL = SQL & "And C014 IN (0, 2)"
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set Result = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for SerialNumber-Regex by ArticleNumber " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "GetArticleNumberFromSecondaryIndentifier"
End If
If Result.RowCount > 0 Then
GetArticleNumberFromSecondaryIndentifier = Result.Value("c010")
Else
GetArticleNumberFromSecondaryIndentifier = ""
End If
End Function

37
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/GetNextFreeArticleRow.vbm Normal file
View File

@@ -0,0 +1,37 @@
' GetNextFreeArticleRow(ArticleNumber : String)
' ----------------------------------------------------------------------------
' Gibt den Grid Index der nächsten freien Zeile für das Scan-Ergebnis zurück
'
' Returns: GetNextFreeArticleRow : Int
' ----------------------------------------------------------------------------
' 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: 30.09.2020 / JJ
' Version Date / Editor: 30.09.2020 / JJ
' Version Number: 1.0.0.0
Function GetNextFreeArticleRow(ArticleNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Dim NextFreeRow : NextFreeRow = -1
If DEBUG_ON = True Then
AddDebugLine "Getting next free row for Article: " & ArticleNumber
ShowDebugBox "GetNextFreeArticleRow"
End If
For GridIndex = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(GridIndex, COLUMN_ARTICLENUMBER)
CurrentSerialNumber = Grid.GetCellValue(GridIndex, COLUMN_SERIALNUMBER)
If UCase(ArticleNumber) = UCase(CurrentArticleNumber) And Len(CurrentSerialNumber) = 0 Then
NextFreeRow = GridIndex
Exit For
End If
Next
GetNextFreeArticleRow = NextFreeRow
End Function

68
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/IsOrderAvailable.vbm Normal file
View File

@@ -0,0 +1,68 @@
' IsOrderAvailable(OrderNumber : String)
' ----------------------------------------------------------------------------
' Überprüft, ob Auftrag noch (teilweise) offen ist
'
' Returns: OrderAvailable: Boolean
' ----------------------------------------------------------------------------
' 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: 01.09.2020 / JJ
' Version Date / Editor: 26.04.2021 / MP
' Version Number: 3.0.0.3
Function IsOrderAvailable(OrderNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Err.Clear
IsOrderAvailable = False
'Set SQL Table and Query for DocHead. Default: "T025"
'c023 - c026 = Druckstufen; c098 = Freigabeflag Angebot; c139 = Belegstufe;
'c035 = Belegart
'--> Query is not complete, will be build in the script later this time!
SQL = ""
SQL = SQL & "(c044 = '" & OrderNumber & "') "
SQL = SQL & "AND (c024 = '*' AND c025 != '*' AND c026 != '*') " ' Auftrag gedruckt, LS/Rech noch nicht gedruckt.
SQL = SQL & "AND (c025 IN ('M', 'A', 'S')) " ' Druckstatus Lieferschein
SQL = SQL & "AND (c115 < 900) " ' Flag Freigabekontrolle Auftrag
SQL = SQL & "AND (c139 = 2) " ' Belegstufe 2 = Auftrag
SQL = SQL & SQLQuery_OrderWhere
Set Result = CWLStart.CurrentCompany.SearchRecord(TABLE_25, SQL)
If DEBUG_ON = True Then
MsgBox "SQL: ... FROM " & TABLE_25 & " WHERE " & SQL, vbOkonly, DEBUG_TITLE
AddDebugLine "Checking For Order by OrderId.." & vbNewline & vbNewline
AddDebugLine "Result Columns: " & Result & vbNewline
AddDebugLine "Result Rows: " & Result.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "IsOrderAvailable"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei SQL-Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - IsOrderAvailable"
Exit Function
Else
Message = "Der Auftrag [" & OrderNumber & "] wurde nicht geladen aus einem der folgenden Gründe:" & vbNewLine & vbNewLine
Message = Message & "- Auftrag existiert nicht" & vbNewLine
Message = Message & "- Auftrag ist durch Fibu gesperrt" & vbNewLine
Message = Message & "- Auftrag wurde bereits erledigt" & vbNewLine
Message = Message & "- Beleg ist kein Auftrag"
MsgBox Message, vbExclamation, DEFAULT_TITLE
Exit Function
End If
End If
If Result.RowCount > 0 Then
IsOrderAvailable = True
End If
End Function

38
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/IsOrderComplete.vbm Normal file
View File

@@ -0,0 +1,38 @@
' IsOrderComplete()
' ----------------------------------------------------------------------------
' Überprüft, ob alle Zeilen vollständig gescannt wurden
'
' Returns: OrderComplete: Boolean
' ----------------------------------------------------------------------------
' 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: 25.09.2020 / JJ
' Version Date / Editor: 01.04.2020 / MP
' Version Number: 3.0.0.2
Function IsOrderComplete()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
IsOrderComplete = True
For GridIndex = 1 To Grid.LineCount: Do
Total = Cint(Grid.GetCellValue(GridIndex, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(GridIndex, COLUMN_SCANNED))
MacroFlag = Cint(Grid.GetCellValue(GridIndex, COLUMN_MACRO_FLAG))
If MacroFlag = 1 Then
' Continue weil Makro-Haupt-Artikel nicht geprüft werden
' Sonstige Artikel, wie z.B. Versandkosten, werden bereits als komplett ins Grid geladen
Exit Do
End If
If Scanned < Total Then
IsOrderComplete = False
Exit For
End If
Loop While False: Next
End Function

86
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/IsOrderLocked.vbm Normal file
View File

@@ -0,0 +1,86 @@
' IsOrderLocked(OrderNumber : Int)
' ----------------------------------------------------------------------------
' Gibt die UserID des Benutzers zurück, der den Auftrag sperrt.
' Wenn der Auftrag nicht gesperrt ist, wird 0 zurückgegeben.
'
' Returns: IsOrderLocked: Int
' ----------------------------------------------------------------------------
' 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: 26.04.2021 / MP
' Version Date / Editor: 26.04.2021 / MP
' Version Number: 3.0.0.3
' Hole die interne Belegnummer
' t025.c021 = Kontonummer und t025.c022 = Laufende Nummer
Function GetInternalOrderNumber(OrderNumber)
GetInternalOrderNumber = ""
Err.Clear
If Len(OrderNumber) > 0 Then
Set Conn = CWLStart.Connection
Dim SQL : SQL = ""
SQL = SQL & " SELECT TOP 1 c021, c022"
SQL = SQL & " FROM t025 (NOLOCK) "
SQL = SQL & " WHERE c044 = '"& OrderNumber & "'"
SQL = SQL & SQLQuery_OrderWhere
SQL = SQL & " ORDER BY c022"
Set Result = Conn.Select(SQL)
If Result < 0 Then
If err <> 0 Then
MsgBox "Fehler bei SQL-Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - GetInternalOrderNumber"
Exit Function
Else
Message = "Den Auftrag [" & OrderNumber & "] gibt es nicht in der Datenbank"
MsgBox Message, vbExclamation, DEFAULT_TITLE
Exit Function
End If
End If
GetInternalOrderNumber = result.Value("c021") & result.Value("c022")
End If
End Function
Function IsOrderLocked(OrderNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Err.Clear
IsOrderLocked = 0
InternalOrderNumber = GetInternalOrderNumber(OrderNumber)
SQL = ""
SQL = SQL & " c001 = 'E" & InternalOrderNumber & "' "
SQL = SQL & SQLQuery_BasicWhere
Set Result = CWLStart.CurrentCompany.SearchRecord(TABLE_499, SQL)
If DEBUG_ON = True Then
MsgBox "SQL: ... FROM " & TABLE_499 & " WHERE " & SQL, vbOkonly, DEBUG_TITLE
AddDebugLine "Checking For Order by internal OrderId [" & InternalOrderNumber & "]:"& vbNewline & vbNewline
AddDebugLine "Result Columns: " & Result & vbNewline
AddDebugLine "Result Rows: " & Result.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "IsOrderLocked"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - IsOrderLocked"
Exit Function
End If
End If
If Result.RowCount > 0 Then
IsOrderLocked = Result.Value("C002")
End If
End Function

459
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/LoadOrder.vbm Normal file
View File

@@ -0,0 +1,459 @@
' LoadOrder(OrderNumber : String)
' ----------------------------------------------------------------------------
' Sucht Belegzeilen zur angegebenen Belegnummer
' - Filtert Artikel der konf. Artikelgruppe (EXCLUDED_ARTICLEGROUPS) aus
' - Lädt Ergebnisse in eine Tabelle auf dem Formular
' - Erzeugt N Zeilen für Seriennummer-Artikel der Menge N
'
' Returns: LoadOrder : Boolean
' ----------------------------------------------------------------------------
' 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: 01.09.2020 / JJ
' Version Date / Editor: 20.07.2021 / MP
' Version Number: 3.0.0.4
Function GetSQL(OrderNumber)
Dim SQL : SQL = ""
SQL = SQL & " SELECT t2.*, t3.c037 c2137, t3.c079 c2179, t3." & ART_REGEX_FLDBEZ & " c21222"
SQL = SQL & " FROM t025 t (NOLOCK)"
SQL = SQL & " JOIN t026 t2 (NOLOCK) ON t.c021 = t2.c044 AND t.c022 = t2.c045"
SQL = SQL & " LEFT OUTER JOIN v021 t3 (NOLOCK) ON t2.c003 = t3.c002 AND t2.mesoyear = t3.mesoyear"
SQL = SQL & " WHERE t.c044 = '"& OrderNumber &"' AND t.c045 IS NULL"
SQL = SQL & " AND (t2.c099 = 0)"
'SQL = SQL & " AND (t2.c005 - t2.c016) > 0 AND (t2.c099 = 0)" --> wegen späten Ausprägungen brauchen wir alle Zeilen
' Nach Mandant und Wirtschaftsjahr filtern
OrderWhere = SQLQuery_OrderWhere
OrderWhere = Replace(OrderWhere, "mesocomp", "t2.mesocomp")
OrderWhere = Replace(OrderWhere, "mesoyear", "t2.mesoyear")
SQL = SQL & OrderWhere
' Nach Zeilennummer sortieren
SQL = SQL & " ORDER BY t2.c000"
GetSQL = SQL
End Function
Function GetMacroArticleCount(MacroName)
Dim CountResult : CountResult = 0
If Len(MacroName) > 0 Then
Set Conn = CWLStart.Connection
Dim SQL : SQL = ""
SQL = SQL & " SELECT count(*) c001"
SQL = SQL & " FROM t326 (NOLOCK) "
SQL = SQL & " WHERE c002 like '"& MacroName &"%'"
SQL = SQL & SQLQuery_BasicWhere
Set Result = Conn.Select(SQL)
CountResult = result.Value("c001")
End If
GetMacroArticleCount = CountResult
End Function
Function FillOrderArticleData(OrderNumber)
Set Conn = CWLStart.Connection
Err.Clear
SQL = GetSQL(OrderNumber)
Set Result = Conn.Select(SQL)
Set CountResult = Result
If DEBUG_ON = True Then
MsgBox "SQL:" & SQL, vbOkonly, DEBUG_TITLE
AddDebugLine "Searching For Order by OrderId (Mid Table).." & vbNewline & vbNewline
AddDebugLine "Result Columns: " & Result & vbNewline
AddDebugLine "Result Rows: " & Result.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "LoadOrder"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - LoadOrder"
Exit Function
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - LoadOrder"
Exit Function
End If
End If
' Belegung globaler Variablen für späteren Gebrauch
ORDER_ACCOUNT_NUMBER = Result.Value("c044")
ORDER_RUNNING_NUMBER = Result.Value("c045")
' Makro-Gruppenwechsel
Dim macroSubArticleCounter : macroSubArticleCounter = 0
Dim macroFlagForSNArticles : macroFlagForSNArticles = 0
Dim macroName : macroName = ""
Dim macroLineNumber : macroLineNumber = 0
Dim macroMaxLineNumber : macroMaxLineNumber = 0 ' Größte Zeilennummer eines Macros
Dim IsLateShape : IsLateShape = 0
OrderArrayIndex = 0
MacroArrayIndex = 0
' Doppelte Do Schleife, um ein "Continue While" zu ermöglichen
Do: Do
macroFlagForSNArticles = 0
AddTwoDimArrayRow ORDER_ARTICLE_DATA
ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex) = result.Value("c078")
ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex) = result.Value("c003")
ORDER_ARTICLE_DATA(INDEX_MAIN_ARTICLE_NUMBER, OrderArrayIndex) = result.Value("c011")
ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex) = result.Value("c012")
ORDER_ARTICLE_DATA(INDEX_DATA_TYPE, OrderArrayIndex) = result.Value("c042")
ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex) = result.Value("c2137")
ORDER_ARTICLE_DATA(INDEX_ARTICLE_TYPE, OrderArrayIndex) = result.Value("c2179")
ORDER_ARTICLE_DATA(INDEX_DESCRIPTION, OrderArrayIndex) = result.Value("c004")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) = result.Value("c005")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex) = result.Value("c016")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_REMAINING, OrderArrayIndex) = result.Value("c099")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_SERIAL_NUMBER, OrderArrayIndex) = ""
ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex) = result.Value("c055")
ORDER_ARTICLE_DATA(INDEX_IS_SERIAL_NUMBER, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_ARTICLE_REGEX, OrderArrayIndex) = result.Value("c21222")
ORDER_ARTICLE_DATA(INDEX_IS_LATE_SHAPE, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = False
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_MACRO_LINE_NUMBER, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_PRICE_VK_EINZEL, OrderArrayIndex) = result.Value("c007")
ORDER_ARTICLE_DATA(INDEX_IS_OPEN, OrderArrayIndex) = False
' Alle Belegzeilen, die schon geliefert wurden, werden von der Restlichen Logik nicht berührt
If (ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) - ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex)) <= 0 Then
' Vorzeitiger Abbruch, trotzdem den Zähler erhöhen
OrderArrayIndex = OrderArrayIndex + 1
Exit Do
Else
ORDER_ARTICLE_DATA(INDEX_IS_OPEN, OrderArrayIndex) = True
End If
If (Len(ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex)) > 0) Then
' Hier haben wir den Makro-Hauptartikel gefunden
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex) = 1
AddTwoDimArrayRow MACRO_ARTICLE_LIST
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_LINE_NUMBER, MacroArrayIndex) = ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex)
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_NUMBER, MacroArrayIndex) = ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex)
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_DESCRIPTION, MacroArrayIndex) = ORDER_ARTICLE_DATA(INDEX_DESCRIPTION, OrderArrayIndex)
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_REMAINING, MacroArrayIndex) = ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) - ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex)
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED, MacroArrayIndex) = 0
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_COMPLETE, MacroArrayIndex) = True 'Wird umgesetzt, falls unvollständig
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_GRID_LINE_INDEX, MacroArrayIndex) = 0
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_SCAN_FLAG, MacroArrayIndex) = False
MacroArrayIndex = MacroArrayIndex + 1
macroLineNumber = ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex)
macroName = ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex)
macroSubArticleCounter = GetMacroArticleCount(ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex)) ' Problematisch bei Teillieferungen
macroMaxLineNumber = macroLineNumber + macroSubArticleCounter
End If
If (ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex) = 0 And _
macroSubArticleCounter > 0 And _
ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex) <= macroMaxLineNumber) Then
' Dies muss ein Sub-Makro-Hauptartikel sein
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex) = 2
' Makro Name für Sub-Makro-Artikel speichern
ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex) = macroName
' Makro Zeilennummer für Sub-Makro-Artikel speichern
ORDER_ARTICLE_DATA(INDEX_MACRO_LINE_NUMBER, OrderArrayIndex) = macroLineNumber
' Nachfolgende S/N Artikel bekommen das gleiche Flag
macroFlagForSNArticles = ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex)
macroSubArticleCounter = macroSubArticleCounter - 1
ElseIf (macroSubArticleCounter = 0 OR _
ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex) > macroMaxLineNumber) Then
macroLineNumber = 0
macroMaxLineNumber = 0
End if
If CheckArticleGroupIsRelevant(ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex)) = False Then
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) - ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex)
End If
' Alle Nicht-Artikel (z.B Texte) immer mit Menge 0
If ORDER_ARTICLE_DATA(INDEX_DATA_TYPE, OrderArrayIndex) <> 1 Then
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) = 0
End If
' Sichtbar Ja / Nein?
If (ORDER_ARTICLE_DATA(INDEX_DATA_TYPE, OrderArrayIndex) = 1 And _
ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex) <> 12 And _
CheckArticleGroupIsRelevant(ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex)) = True) Then
ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = True
End If
' Wenn Option Alle Artikel Sichtbar aktiv ist
If (OPTION_ALL_ARTICLES > 0 And _
ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = False) Then
ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = True
End If
If (ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex) = 2) Then
ORDER_ARTICLE_DATA(INDEX_IS_SERIAL_NUMBER, OrderArrayIndex) = 1
End If
If (Len(ORDER_ARTICLE_DATA(INDEX_ARTICLE_REGEX, OrderArrayIndex)) > 0) Then
ORDER_ARTICLE_DATA(INDEX_IS_LATE_SHAPE, OrderArrayIndex) = 1
IsLateShape = 1
Else
ORDER_ARTICLE_DATA(INDEX_IS_LATE_SHAPE, OrderArrayIndex) = 0
IsLateShape = 0
End If
If (Len(Result.Value("c067")) > 0) Then
' Belegung hier, weil Text-Artikel keine Belegnummer enthalten
ORDER_DOCUMENT_NUMBER = Result.Value("c067")
End If
' Duplikate scanbarer Artikel ermitteln
If (ORDER_ARTICLE_DATA(INDEX_DATA_TYPE, OrderArrayIndex) = 1 And _
ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex) <> 12 And _
CheckArticleGroupIsRelevant(ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex)) = True And _
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex) <> 1) Then
AddArticleNumberToDuplList ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex), _
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex), _
ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex)
End If
Dim AmountOrdered, AmountDelivered, ChargeFlag
ChargeFlag = CInt(result.Value("c055"))
AmountOrdered = CInt(result.Value("c005"))
AmountDelivered = CInt(result.Value("c016"))
Amount = AmountOrdered - AmountDelivered
If ChargeFlag = 2 Then
' Amount wird um 1 reduziert, da für den Artikel bereits
' eine Zeile aus der Schleife oben existiert
For Index = 1 To Amount - 1
AddTwoDimArrayRow ORDER_ARTICLE_DATA
OrderArrayIndex = OrderArrayIndex + 1
ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex) = result.Value("c078")
ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex) = result.Value("c003")
ORDER_ARTICLE_DATA(INDEX_MAIN_ARTICLE_NUMBER, OrderArrayIndex) = result.Value("c011")
ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex) = result.Value("c012")
ORDER_ARTICLE_DATA(INDEX_DATA_TYPE, OrderArrayIndex) = result.Value("c042")
ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex) = macroName
ORDER_ARTICLE_DATA(INDEX_ARTICLE_TYPE, OrderArrayIndex) = result.Value("c2179")
ORDER_ARTICLE_DATA(INDEX_DESCRIPTION, OrderArrayIndex) = result.Value("c004")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) = result.Value("c005")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex) = result.Value("c016")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_REMAINING, OrderArrayIndex) = result.Value("c099")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_SERIAL_NUMBER, OrderArrayIndex) = ""
ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex) = result.Value("c055")
ORDER_ARTICLE_DATA(INDEX_IS_SERIAL_NUMBER, OrderArrayIndex) = 1
ORDER_ARTICLE_DATA(INDEX_ARTICLE_REGEX, OrderArrayIndex) = result.Value("c21222")
ORDER_ARTICLE_DATA(INDEX_IS_LATE_SHAPE, OrderArrayIndex) = IsLateShape
ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = True
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex) = macroFlagForSNArticles
ORDER_ARTICLE_DATA(INDEX_MACRO_LINE_NUMBER, OrderArrayIndex) = macroLineNumber
ORDER_ARTICLE_DATA(INDEX_PRICE_VK_EINZEL, OrderArrayIndex) = result.Value("c007")
ORDER_ARTICLE_DATA(INDEX_IS_OPEN, OrderArrayIndex) = True
' Wir benötigen die korrekte Anzahl der Zeilen eines Artikels
AddArticleNumberToDuplList ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex), _
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex), _
ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex)
Next
End If
OrderArrayIndex = OrderArrayIndex + 1
' Doppelte Do Schleife, um ein "Continue While" zu ermöglichen
Loop While False: Loop While Result.NextRecord = True
' Enthält die Anzahl der Macro-Hauptartikel
MACRO_ARTICLE_COUNTER = MacroArrayIndex
FillOrderArticleData = OrderArrayIndex
End Function
Function LoadOrder(OrderNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
ASK_FOR_DELNOTE = False
If (FillOrderArticleData(OrderNumber) <= 0) Then
LoadOrder = False
Exit Function
ElseIf (ExistVisibleRows() = False) Then
' Es gibt keine sichtbaren Zeilen, d.h. es gibt auch nix zu scannen.
' Da aber ein Lieferschein erzeugt werden kann, zeigen wir jetzt alles an,
' und fragen nach dem Laden ob der letzte LS direkt erstellt werden soll
ShowAllArticles()
ASK_FOR_DELNOTE = True
End If
Grid.InitUserGrid
Grid.Header
Grid.Clear(1002)
Grid.IsRedraw = False
' Zähler für Grid
' Wird immer hoch gezählt bei Grid.AddLine
GridLineCounter = 1
' Zähler für Datenstruktur
' Wird in JEDEM Durchlauf hochgezählt
OrderArrayIndex = 0
Do
' Speicher für benutzerdefinierte Felder im Grid
' (495,0) - Menge Gesamt
' (495,1) - Menge Gescannt
' (495,2) - Seriennummer
' (495,3) - Artikelnummer
' (495,4) - Bezeichnung
' (495,5) - Seriennummer Ja/Nein
' (495,6) - Spät Ausprägung Ja/Nein
' (495,7) - Interne Zeilennumemr
Dim AmountOrdered, AmountDelivered
AmountOrdered = Cint(ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex))
AmountDelivered = Cint(ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex))
ProductGroup = Cint(ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex))
Amount = AmountOrdered - AmountDelivered
SalesMacro = ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex)
ArticleType = ORDER_ARTICLE_DATA(INDEX_ARTICLE_TYPE, OrderArrayIndex)
ChargeFlag = Cint(ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex))
IsLateShape = Cint(ORDER_ARTICLE_DATA(INDEX_IS_LATE_SHAPE, OrderArrayIndex))
ArticleNumber = ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex)
Description = ORDER_ARTICLE_DATA(INDEX_DESCRIPTION, OrderArrayIndex)
IsVisible = ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex)
LineNumber = CInt(ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex))
IsSerialNumber = CInt(ORDER_ARTICLE_DATA(INDEX_IS_SERIAL_NUMBER, OrderArrayIndex))
MacroFlag = CInt(ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex))
MacroLineNumber = CInt(ORDER_ARTICLE_DATA(INDEX_MACRO_LINE_NUMBER, OrderArrayIndex))
If (IsVisible = True) Then
If ChargeFlag = 2 Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = 1
CWLCurrentWindow.ActiveWindow.Vars.Value(495,1) = 0
ResetableFlag = 1
If MacroFlag = 2 Then
LineColor = COLOR_PACKAGE_RED
AddMacroLineNumberTokensToDuplicateArticles ArticleNumber, MacroLineNumber
Else
LineColor = COLOR_RED
End If
' GridLine Index der Duplikate-Struktur hinzufügen
AddGridLineIndexToDuplicateArticles ArticleNumber, GridLineCounter
ElseIf (CheckArticleGroupIsRelevant(ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex)) = False) OR AmountOrdered = 0 Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = Amount
CWLCurrentWindow.ActiveWindow.Vars.Value(495,1) = Amount
ResetableFlag = 0
If MacroFlag = 2 Then
LineColor = COLOR_PACKAGE_GREEN
Else
LineColor = COLOR_GREEN
End If
ElseIf MacroFlag = 1 Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = Amount
CWLCurrentWindow.ActiveWindow.Vars.Value(495,1) = 0
ResetableFlag = 0
LineColor = COLOR_BLUE
Else
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = Amount
CWLCurrentWindow.ActiveWindow.Vars.Value(495,1) = 0
ResetableFlag = 1
If MacroFlag = 2 Then
LineColor = COLOR_PACKAGE_RED
AddMacroLineNumberTokensToDuplicateArticles ArticleNumber, MacroLineNumber
Else
LineColor = COLOR_RED
End If
' GridLine Index der Duplikate-Struktur hinzufügen
AddGridLineIndexToDuplicateArticles ArticleNumber, GridLineCounter
End If
CWLCurrentWindow.ActiveWindow.Vars.Value(495,2) = ""
CWLCurrentWindow.ActiveWindow.Vars.Value(495,3) = ArticleNumber
CWLCurrentWindow.ActiveWindow.Vars.Value(495,4) = Description
CWLCurrentWindow.ActiveWindow.Vars.Value(495,5) = IsSerialNumber
CWLCurrentWindow.ActiveWindow.Vars.Value(495,6) = IsLateShape
CWLCurrentWindow.ActiveWindow.Vars.Value(495,7) = LineNumber
CWLCurrentWindow.ActiveWindow.Vars.Value(495,8) = GridLineCounter
CWLCurrentWindow.ActiveWindow.Vars.Value(495,9) = ResetableFlag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,10) = MacroFlag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,11) = MacroLineNumber
' Neue Grid-Zeile schreiben
Grid.AddLine
' Zeilenfarbe mit ROT vorbelegen
Grid.SetLineColor GridLineCounter, LineColor
GridLineCounter = GridLineCounter + 1
End If
OrderArrayIndex = OrderArrayIndex + 1
Loop While OrderArrayIndex < (UBound(ORDER_ARTICLE_DATA, 2) + 1)
LoadOrder = True
Grid.IsRedraw = True
End Function
' Schaltet alle nicht sichtbaren Felder auf sichtbar um
Sub ShowAllArticles
For OrderArrayIndex = 0 to UBound(ORDER_ARTICLE_DATA, 2)
If (ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = False And ORDER_ARTICLE_DATA(INDEX_IS_OPEN, OrderArrayIndex) = True) Then
ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = True
End If
Next
End Sub
' Gibt True zurück, wenn es min. 1 sichtbare Zeile gibt
Function ExistVisibleRows
ExistVisibleRows = False
For OrderArrayIndex = 0 to UBound(ORDER_ARTICLE_DATA, 2)
If (ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = True) Then
ExistVisibleRows = True
Exit For
End If
Next
End Function

112
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/ResetValuesByLineIndex.vbm Normal file
View File

@@ -0,0 +1,112 @@
' ResetValuesByLineIndex(LineIndex : INT)
' ----------------------------------------------------------------------------
' Setzt die Werte in einer bestimmten Zeile auf ihre
' Ausgangswerte zurück.
'
' 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: 15.03.2021 / MP
' Version Date / Editor: 15.03.2021 / MP
' Version Number: 3.0.0.1
Sub ResetValues(GridLineIndexToReset)
Set myWin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = myWin.Controls.Item(GRID_ID).Grid
For GridIndex = 1 To Grid.LineCount
If GridIndex = GridLineIndexToReset Then
Grid.SetCellValue GridIndex, COLUMN_SCANNED, 0
Grid.SetCellValue GridIndex, COLUMN_SERIALNUMBER, ""
If (Grid.GetCellValue(GridIndex, COLUMN_MACRO_FLAG) = 2) Then
Grid.SetLineColor GridIndex, COLOR_PACKAGE_RED
Else
Grid.SetLineColor GridIndex, COLOR_RED
End If
Exit For
End If
Next
End Sub
Sub ResetValuesByMacroLineNumber(MacroArticleLineNumber)
Set myWin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = myWin.Controls.Item(GRID_ID).Grid
For GridIndex = 1 To Grid.LineCount
MacroLineNumber = Cint(Grid.GetCellValue(GridIndex, COLUMN_MACRO_LINE_NUMBER))
If MacroLineNumber = MacroArticleLineNumber Then
Grid.SetCellValue GridIndex, COLUMN_SCANNED, 0
Grid.SetCellValue GridIndex, COLUMN_SERIALNUMBER, ""
Grid.SetLineColor GridIndex, COLOR_PACKAGE_RED
End If
Next
End Sub
Sub ResetValuesByLineIndex(LineIndex)
Set myWin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = myWin.Controls.Item(GRID_ID).Grid
If (Grid.LineCount <= 0) Then
MsgBox "Bitte scannen Sie zuerst eine Auftragsnummer!", vbOKOnly + vbInformation, DEFAULT_TITLE
Exit Sub
End If
Dim LineIndexToReset : LineIndexToReset = 0
If (LineIndex = -1) Then
InputBoxHeaderText = "Zeile zurücksetzen"
If (Grid.LineCount = 1) Then
InputBoxText = "Zeilennummer:"
InputBoxDefault = "1"
Else
InputBoxText = "Zeilennummer (Zeile [1 - " & Grid.LineCount & "]):"
InputBoxDefault = "0"
End If
LineIndexInputBox = InputBox(InputBoxText, InputBoxHeaderText, InputBoxDefault)
Select Case True
Case IsEmpty(LineIndexInputBox)
' Abbruch der Box
Exit Sub
Case "" = Trim(LineIndexInputBox)
' Kein Wert eingegeben = Abbruch
Exit Sub
Case Else
' Wert eingegeben und OK geklickt
If Len(LineIndexInputBox) > 0 Then
LineIndexToReset = Cint(LineIndexInputBox)
Else
LineIndexToReset = 0
End If
End Select
Else
LineIndexToReset = LineIndex
End If
If (LineIndexToReset <= 0 OR LineIndexToReset > Grid.LineCount) Then
MsgBox "Keine gültige Zeile ausgewählt!", vbOKOnly + vbInformation, DEFAULT_TITLE
ElseIf (Grid.GetCellValue(LineIndexToReset, COLUMN_RESETABLE_FLAG) = 0) Then
MsgBox "Die Zeile [" & LineIndexToReset & "] ist nicht änderbar!", vbOKOnly + vbInformation, DEFAULT_TITLE
ElseIf (LineIndexToReset > 0 And LineIndexToReset <= Grid.LineCount) Then
Answer = MsgBox("Sollen die Werte in Zeile [" & LineIndexToReset & "] zurückgesetzt werden?", vbYesno + vbQuestion, DEFAULT_TITLE)
If Answer = vbYes Then
ResetValues LineIndexToReset
CURRENT_GRID_LINE_INDEX = 0
End If
Else
MsgBox "Diese Zeilennummer gibt es nicht!"
End If
End Sub

30
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/SerialNumberExists.vbm Normal file
View File

@@ -0,0 +1,30 @@
' SerialNumberExists(SerialNumber : String)
' ----------------------------------------------------------------------------
' Prüft, ob die übergebene Seriennummer bereits gescannt wurde
'
' Returns: SerialNumberExists : Boolean
' ----------------------------------------------------------------------------
' 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: 25.09.2020 / JJ
' Version Date / Editor: 25.09.2020 / JJ
' Version Number: 1.0.0.0
Function SerialNumberExists(SerialNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
SerialNumberExists = False
For GridIndex = 1 To Grid.LineCount
CurrentSerialNumber = Grid.GetCellValue(GridIndex, COLUMN_SERIALNUMBER)
If SerialNumber = CurrentSerialNumber Then
SerialNumberExists = True
Exit For
End If
Next
End Function

27
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/SetAmount.vbm Normal file
View File

@@ -0,0 +1,27 @@
' SetAmount(Amount: Integer)
' ----------------------------------------------------------------------------
' Setzt eingegebene Menge in das Mengenfeld ein
' - Überschreibt Menge beim ersten Eintrag, danach
' wird die Zahl angehängt
'
' 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: 25.09.2020 / JJ
' Version Date / Editor: 25.09.2020 / JJ
' Version Number: 1.0.0.0
Sub SetAmount(Amount)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
If amountBox.Contents = AMOUNT_PLACEHOLDER Then
amountBox.Contents = Cstr(Amount)
Else
amountBox.Contents = amountBox.Contents & Cstr(Amount)
End If
End Sub

32
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/SetDebugMode.vbm Normal file
View File

@@ -0,0 +1,32 @@
' SetDebugMode()
' ----------------------------------------------------------------------------
' Zeigt je nach DEBUG-Mode die nicht sichtbaren Spalten
' im Grid an oder nicht, je nach DEBUG_ON-Einstellung.
'
' 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: 01.04.2021 / MP
' Version Date / Editor: 01.04.2021 / MP
' Version Number: 3.0.0.2
Sub SetDebugMode()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
' Unsichtbare Spalten anzeigen im DEBUG-Modus
Dim invisibleColWidth : invisibleColWidth = 0
If DEBUG_ON = True Then
invisibleColWidth = 5
End If
Grid.SetColumnWidth COLUMN_LINE_NUMBER, invisibleColWidth
Grid.SetColumnWidth COLUMN_RESETABLE_FLAG, invisibleColWidth
Grid.SetColumnWidth COLUMN_MACRO_FLAG, invisibleColWidth
Grid.SetColumnWidth COLUMN_MACRO_LINE_NUMBER, invisibleColWidth
End Sub

87
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/SetupWindow.vbm Normal file
View File

@@ -0,0 +1,87 @@
' SetupWindow()
' ----------------------------------------------------------------------------
' Definiert die Spalten des Grids und initialisiert Felder
'
' 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: 01.09.2020 / JJ
' Version Date / Editor: 30.03.2021 / MP
' Version Number: 3.0.0.1
Sub SetupWindow()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
' Speicher für benutzerdefinierte Felder
' (495,0) - Menge Gesamt
' (495,1) - Menge Gescannt
' (495,2) - Seriennummer
' (495,3) - Artikelnummer
' (495,4) - Bezeichnung
' (495,5) - Chargen-/Identflag
' (495,6) - Spät ausgeprägt bzw. Regex vorhanden
' (495,7) - Interne Zeilennummer aus Auftrag
' (495,8) - Sichtbare Zeilennummer im Grid
' (495,9) - Zeile darf resettet werden (J/N)
' (495,10) - Makro Flag (0 - Default / 1 = Macro-Artikel / 2 = Sub-Macro-Artikel)
' (495,11) - Makro Index, Zeilennummer des übergeordneten Makro-Artikels
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 0, "2", 10
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 1, "2", 10
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 2, "1", 20
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 3, "1", 20
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 4, "1", 60
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 5, "2", 3
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 6, "2", 3
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 7, "2", 3
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 8, "2", 4
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 9, "2", 3
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 10, "2", 3
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 11, "2", 3
Grid.InitUserGrid
Grid.IsRedraw = False
Grid.Header
If COLUMNS_CREATED = False Then
COLUMN_GRID_LINE_INDEX = Grid.AddColumn("#", "T22,Zeilenindex", "z", "V", 0, 495, 8, 4, sizeflag+hideflag)
COLUMN_ARTICLENUMBER = Grid.AddColumn("Artikelnummer", "T21,Artikelnummer", "l", "V", 0, 495, 3, 15, sizeflag+hideflag)
COLUMN_DESCRIPTION = Grid.AddColumn("Bezeichnung", "T21,Bezeichnung", "l", "V", 0, 495, 4, 37, sizeflag+hideflag)
COLUMN_TOTAL = Grid.AddColumn("Gesamt", "T22,Gesamt", "z", "V", 0, 495, 0, 10, sizeflag+hideflag)
COLUMN_SCANNED = Grid.AddColumn("Gescannt", "T22,Gescannt", "z", "V", 0, 495, 1, 10, sizeflag+hideflag)
COLUMN_SERIALNUMBER = Grid.AddColumn("Seriennummer", "T21,Seriennummer", "l", "V", 0, 495, 2, 20, sizeflag+hideflag)
COLUMN_CHARGE_FLAG = Grid.AddColumn("S/N?", "T17,Seriennummer", "l", "V", 0, 495, 5, 6, sizeflag+hideflag)
COLUMN_LATE_SHAPE = Grid.AddColumn("Auspr?", "T17,Spaetausgepr.", "l", "V", 0, 495, 6, 6, sizeflag+hideflag)
COLUMN_LINE_NUMBER = Grid.AddColumn("LN", "T22,Zeilennummer", "r", "V", 0, 495, 7, 0, 0) ' nicht sichtbar
COLUMN_RESETABLE_FLAG = Grid.AddColumn("RF", "T22,ResetableFlag", "r", "V", 0, 495, 9, 0, 0) ' nicht sichtbar
COLUMN_MACRO_FLAG = Grid.AddColumn("MF", "T22,MacroFlag", "r", "V", 0, 495, 10, 0, 0) ' nicht sichtbar
COLUMN_MACRO_LINE_NUMBER = Grid.AddColumn("MLN", "T22,MacroZeilenr", "r", "V", 0, 495, 11, 0, 0) ' nicht sichtbar
COLUMNS_CREATED = True
End If
Grid.IsRedraw = True
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
amountBox.Contents = AMOUNT_PLACEHOLDER
Set articleBox = mywin.Controls.Item(ARTICLE_INPUT)
articleBox.Contents = ""
' Merker für Resetbutton
CURRENT_GRID_LINE_INDEX = 0
PRINT_DOCUMENT_AFTER_COMPLETION = True
SetLabelText TEXT_CONFIG_INFO, 495, 71, ""
' Arrays reinitialisieren
Redim ORDER_ARTICLE_DATA(MAX_ORDER_COLUMN_COUNT, -1)
Redim MACRO_ARTICLE_LIST(MAX_MACRO_COLUMN_COUNT, -1)
Redim DUPL_ARTICLE_LIST(MAX_DUPL_COLUMN_COUNT, -1)
MacroCommands.MSetFieldFocus WINDOW_ID, ORDER_INPUT
End Sub

62
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/TestArticleHasSerialNumberRegex.vbm Normal file
View File

@@ -0,0 +1,62 @@
' TestArticleHasSerialNumberRegex(Identifier: String)
' ----------------------------------------------------------------------------
' Findet Artikelnummer anhand von versch. Kriterien
' - Artikel-Nummer, Alternative Artikel-Nummer, EAN-Code, Seriennummer
' - Gibt die Zeile im Grid zurück in der Artikel das erste Mal gefunden wurde
'
' Returns: TestArticleHasSerialNumberRegex : Boolean
' ----------------------------------------------------------------------------
' 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: 25.09.2020 / JJ
' Version Date / Editor: 20.07.2021 / MP
' Version Number: 3.0.0.4
Function TestArticleHasSerialNumberRegex(Identifier)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
If DEBUG_ON = True Then
AddDebugLine "Testing for Regex in Identifier: " & Identifier
ShowDebugBox "TestArticleHasSerialNumberRegex"
End If
SQL = ""
' Artikelnummer / EAN-Code / Alternative Artikelnummer
SQL = SQL & "((C002 = '" & Identifier & "') Or (C075 = '" & Identifier & "') Or (C114 = '" & Identifier & "')) AND "
' Serienummer-Regex (Default: C222) muss vorhanden sein
SQL = SQL & "(" & ART_REGEX_FLDBEZ & " IS NOT NULL) AND "
' Artikel darf nicht inaktiv sein
SQL = SQL & "(c038 IS NULL) "
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
If DEBUG_ON = True Then
AddDebugLine "SQL: " & SQL
ShowDebugBox "TestArticleHasSerialNumberRegex"
End If
Set Result = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for SerialNumber-Regex by ArticleNumber " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "TestArticleHasSerialNumberRegex"
End If
If Result.RowCount > 0 Then
TestArticleHasSerialNumberRegex = True
Else
TestArticleHasSerialNumberRegex = False
End If
End Function

37
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/TestHasFreeArticleRow.vbm Normal file
View File

@@ -0,0 +1,37 @@
' TestHasFreeArticleRow(ArticleNumber : String)
' ----------------------------------------------------------------------------
' Sucht die nächste freie Zeile für eine gescannte Seriennummer
'
' Returns: TestHasFreeArticleRow : Boolean
' ----------------------------------------------------------------------------
' 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: 25.09.2020 / JJ
' Version Date / Editor: 25.09.2020 / JJ
' Version Number: 1.0.0.0
Function TestHasFreeArticleRow(ArticleNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Dim NextFreeRow : NextFreeRow = False
If DEBUG_ON = True Then
AddDebugLine "Getting next free row for Article: " & ArticleNumber
ShowDebugBox "TestHasFreeArticleRow"
End If
For GridIndex = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(GridIndex, COLUMN_ARTICLENUMBER)
CurrentSerialNumber = Grid.GetCellValue(GridIndex, COLUMN_SERIALNUMBER)
If UCase(ArticleNumber) = UCase(CurrentArticleNumber) And Len(CurrentSerialNumber) = 0 Then
NextFreeRow = True
Exit For
End If
Next
TestHasFreeArticleRow = NextFreeRow
End Function

43
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/TestIsWebserviceResponseSuccessful.vbm Normal file
View File

@@ -0,0 +1,43 @@
' TestIsWebserviceResponseSuccessful(XmlString : String)
' ----------------------------------------------------------------------------
' Prüft, ob im WebService Result, ein Success enthalten ist
'
' Returns: TestIsWebserviceResponseSuccessful : Boolean
' ----------------------------------------------------------------------------
' 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: 23.10.2020 / JJ
' Version Date / Editor: 23.10.2020 / JJ
' Version Number: 1.0.0.0
Function TestIsWebserviceResponseSuccessful(XmlString)
' Check if XmlString is actually a xml string
If InStr(XmlString, "<?xml") = 1 Then
Set Doc = CreateObject("MSXML2.DOMDocument")
Doc.loadXML(XmlString)
Set Nodes = Doc.SelectNodes("MESOWebServiceResult/ResultDetails")
Set OverallSuccess = Doc.SelectSingleNode("MESOWebServiceResult/OverallSuccess")
If OverallSuccess.Text = "true" Then
Dim IsSuccess : IsSuccess = True
For Each Node in Nodes
Set Success = Node.SelectSingleNode("Success")
If Success.Text <> "true" Then
IsSuccess = False
End If
Next
TestIsWebserviceResponseSuccessful = IsSuccess
Else
TestIsWebserviceResponseSuccessful = False
End If
Else
TestIsWebserviceResponseSuccessful = False
End If
End Function

65
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/TransferGridData.vbm Normal file
View File

@@ -0,0 +1,65 @@
' TransferGridData()
' ----------------------------------------------------------------------------
' Überführt die Gescannten Daten aus dem Grid in die Datenstruktur
'
' Returns: TransferGridData: Boolean
' ----------------------------------------------------------------------------
' 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: 01.09.2021 / JJ
' Version Date / Editor: 25.03.2021 / MP
' Version Number: 3.0.0.1
Function TransferGridData()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
For GridIndex = 1 To Grid.LineCount: Do
Total = Cint(Grid.GetCellValue(GridIndex, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(GridIndex, COLUMN_SCANNED))
ChargeFlag = Cint(Grid.GetCellValue(GridIndex, COLUMN_CHARGE_FLAG)) ' Checkbox-Werte = 0 oder 1
' Zeilennummer aus Auftrag
LineNumber = Cint(Grid.GetCellValue(GridIndex, COLUMN_LINE_NUMBER))
SerialNumber = Grid.GetCellValue(GridIndex, COLUMN_SERIALNUMBER)
MacroFlag = Grid.GetCellValue(GridIndex, COLUMN_MACRO_FLAG)
If Scanned = 0 Then
Exit Do
End If
For OrderArrayIndex = 0 To Ubound(ORDER_ARTICLE_DATA, 2)
If ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = True Then
If ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex) = LineNumber Then
If MacroFlag = 1 Then
For MacroArrayIndex = 0 To UBound(MACRO_ARTICLE_LIST)
If (MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_LINE_NUMBER, MacroArrayIndex) = LineNumber) Then
If (MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_COMPLETE, MacroArrayIndex) = True) Then
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_REMAINING, MacroArrayIndex)
Else
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED, MacroArrayIndex)
End If
Exit For
End If
Next
ElseIf ChargeFlag = 1 And Len(ORDER_ARTICLE_DATA(INDEX_SERIAL_NUMBER, OrderArrayIndex)) = 0 Then
ORDER_ARTICLE_DATA(INDEX_SERIAL_NUMBER, OrderArrayIndex) = SerialNumber
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = Scanned
Exit For
ElseIf ChargeFlag = 0 Then
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = Scanned
Exit For
End If
End If
End If
Next
Loop While False: Next
TransferGridData = True
End Function

42
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/TransferMacroData.vbm Normal file
View File

@@ -0,0 +1,42 @@
' TransferMacroData()
' ----------------------------------------------------------------------------
' Überführt die Daten aus dem Macro-Array zurück ins Grid
'
' 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: 08.03.2021 / MP
' Version Date / Editor: 08.03.2021 / MP
' Version Number: 3.0.0.0
Sub TransferMacroData()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
For GridIndex = 1 To Grid.LineCount: Do
MacroFlag = Cint(Grid.GetCellValue(GridIndex, COLUMN_MACRO_FLAG))
If MacroFlag = 1 Then
LineNumber = Cint(Grid.GetCellValue(GridIndex, COLUMN_LINE_NUMBER))
For MacroArrayIndex = 0 To UBound(MACRO_ARTICLE_LIST, 2)
' Wenn die Menge in COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED > 0 ist,
' dann muss dieser Wert ins Grid zurück geschrieben werden.
If (MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_LINE_NUMBER, MacroArrayIndex) = LineNumber) And _
(MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED, MacroArrayIndex) > 0) Then
Grid.SetCellValue GridIndex, COLUMN_SCANNED, MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED, MacroArrayIndex)
Exit For
End If
Next
Else
' Continue
Exit Do
End If
Loop While False: Next
End Sub

97
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/UpdateArticleRow.vbm Normal file
View File

@@ -0,0 +1,97 @@
' UpdateArticleRow(RowNumber: Integer)
' ----------------------------------------------------------------------------
' Trägt die gescannte Menge eines Artikel in das Grid ein
' - Ändert die Farbe, abhängig von Gesamtmenge und Gescannte Menge
' - Überprüft, ob der Artikel in der Gescannten Menge auf Lager liegt
'
' Returns: UpdateArticleRow : Boolean
' ----------------------------------------------------------------------------
' 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: 01.09.2021 / JJ
' Version Date / Editor: 25.03.2021 / MP
' Version Number: 3.0.0.1
' Aktualisiert den Wert COLUMN_MACRO_ARTICLE_SCAN_FLAG für den aktuellen
' MacroIndex
Sub UpdateMacroArticleRow(MacroArticleLineNumber)
For MacroArrayIndex = 0 To UBound(MACRO_ARTICLE_LIST): Do
If MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_LINE_NUMBER, MacroArrayIndex) = MacroArticleLineNumber Then
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_SCAN_FLAG, MacroArrayIndex) = True
Exit For
End If
Loop While False: Next
End Sub
Function UpdateArticleRow(RowNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
' Bereits gescannte, Gesamt und Anzahl zu Scannen auslesen
ArticleNumber = Grid.GetCellValue(RowNumber, COLUMN_ARTICLENUMBER)
Total = Cint(Grid.GetCellValue(RowNumber, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(RowNumber, COLUMN_SCANNED))
ScannedAmount = Cint(amountBox.Contents)
MacroFlag = Cint(Grid.GetCellValue(RowNumber, COLUMN_MACRO_FLAG))
MacroArticleLineNumber = Cint(Grid.GetCellValue(RowNumber, COLUMN_MACRO_LINE_NUMBER))
' Standard Rückgabewert setzen
UpdateArticleRow = True
' Aktuellen Lagerstand abfragen
StockedAmount = GetWinLineStockedAmount(ArticleNumber, False)
' Neue bereits gescannte berechnen
NewScanned = Scanned + ScannedAmount
If DEBUG_ON = True Then
AddDebugLine "Total " & Total
AddDebugLine "Scanned: " & Scanned
AddDebugLine "NewScanned: " & NewScanned
AddDebugLine "StockedAmount: " & StockedAmount
ShowDebugBox "UpdateArticleRow"
End If
' Zeilenfarbe anpassen:
' GRÜN: Komplett gescannt
' GELB: Teilweise gescannt
If NewScanned > StockedAmount Then
Message = ""
Message = Message & "Der Artikel ist nur in der Menge " & StockedAmount & " vorhanden." & vbNewline
Message = Message & "Der Scan wird abgebrochen!"
Msgbox Message, vbExclamation, DEFAULT_TITLE
Elseif NewScanned = Total Then
If MacroFlag = 2 Then
Grid.SetLineColor RowNumber, COLOR_PACKAGE_GREEN
UpdateMacroArticleRow(MacroArticleLineNumber)
ReduceSubMacroCounterInDuplList ArticleNumber, MacroArticleLineNumber
Else
Grid.SetLineColor RowNumber, COLOR_GREEN
End If
Grid.SetCellValue RowNumber, COLUMN_SCANNED, NewScanned
ReduceCounterInDuplList ArticleNumber, MacroFlag
Elseif NewScanned < Total Then
If MacroFlag = 2 Then
Grid.SetLineColor RowNumber, COLOR_PACKAGE_YELLOW
UpdateMacroArticleRow(MacroArticleLineNumber)
Else
Grid.SetLineColor RowNumber, COLOR_YELLOW
End If
Grid.SetCellValue RowNumber, COLUMN_SCANNED, NewScanned
Else
Message = ""
Message = Message & "Die eingegebene Menge überschreitet die Gesamtanzahl oder" & vbNewline
Message = Message & "der Artikel wurde bereits vollständig gescannt!"
Msgbox Message, vbExclamation, DEFAULT_TITLE
UpdateArticleRow = False
End If
End Function

51
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/UpdateDeliveryNote.vbm Normal file
View File

@@ -0,0 +1,51 @@
' UpdateDeliveryNote(OrderNumber: String)
' ----------------------------------------------------------------------------
' Füllt zusätzliche Felder in der Tabelle t025 (Belegkopf)
' - User ID (FLD_BENUTZERNUMMER_PACKTISCH)
' - Datum und Uhrzeit der LS-Erzeugung (FLD_ERSTELLDATUM_PACKTISCH)
' - Name des Computers an dem der Packtisch läuft (FLD_COMPUTERNAME_PACKTISCH)
' - Packtischversion (FLD_VERSION_PACKTISCH)
'
' 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: 26.04.2021 / MP
' Version Date / Editor: 23.06.2021 / MP
' Version Number: 3.0.0.4
Sub UpdateDeliveryNote(OrderNumber)
Err.Clear
If USE_ADDITIONAL_DBFIELDS = False Then
Exit Sub
End If
Dim SQL : SQL = ""
Dim NowObject : NowObject = Now
Dim UserNumber : UserNumber = CWLStart.CurrentUser.Number
Dim DateString : DateString = Year(NowObject) & "-" & GetLeftPad(Month(NowObject)) & "-" & GetLeftPad(Day(NowObject))
Dim TimeString : TimeString = GetLeftPad(Hour(NowObject)) & ":" & GetLeftPad(Minute(NowObject)) & ":" & GetLeftPad(Second(NowObject))
Dim ComputerName : ComputerName = GetWindowsEnvironment("COMPUTERNAME")
SQL = SQL & " UPDATE t025 SET "
SQL = SQL & FLD_BENUTZERNUMMER_PACKTISCH & " = " & UserNumber & ", "
SQL = SQL & FLD_ERSTELLDATUM_PACKTISCH & " = '" & DateString & " " & TimeString & "', "
SQL = SQL & FLD_COMPUTERNAME_PACKTISCH & " = '" & ComputerName & "', "
SQL = SQL & FLD_VERSION_PACKTISCH & " = '" & PACKTISCH_VERSION & "' "
SQL = SQL & " WHERE c000 = (SELECT TOP 1 c000 FROM t025 WHERE c029 IS NOT NULL AND c044 = '" & OrderNumber & "' " & SQLQuery_OrderWhere & " ORDER BY ts DESC) " & SQLQuery_OrderWhere
If DEBUG_ON = True Then
AddDebugLine "SQL: " & SQL
ShowDebugBox "UpdateDeliveryNote"
End If
CWLStart.Connection.ExecuteSQL(SQL)
If err <> 0 Then
MsgBox "Fehler beim Updaten des Lieferscheins: " & err.number & " - " & err.description
End If
End Sub

73
archive/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/UpdateOrderDataBeforeDelNote.vbm Normal file
View File

@@ -0,0 +1,73 @@
' UpdateOrderDataBeforeDelNote()
' ----------------------------------------------------------------------------
' Vor der Erstellung des Lieferscheins, können hier noch
' Werte in der Datenstruktur korrigiert werden.
'
' Beispiel: Versandkosten in Package-Artikeln
'
' 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: 08.03.2021 / JJ
' Version Date / Editor: 24.06.2021 / MP
' Version Number: 3.0.0.4
Sub UpdateOrderDataBeforeDelNote()
Dim MacroAmountFaktor
Dim MacroComplete
Dim MacroAmountScanned
For OrderArrayIndex = 0 To Ubound(ORDER_ARTICLE_DATA, 2)
If DEBUG_ON = True Then
AddDebugLine "Current ORDER_ARTICLE_DATA values for Index: " & OrderArrayIndex
AddDebugLine "LineNumber: " & vbTab & ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex)
AddDebugLine "ArticleNumber: " & vbTab & ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex)
AddDebugLine "MacroFlag: " & vbTab & ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex)
AddDebugLine "ProductGroup: " & vbTab & ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex)
AddDebugLine "AmountOrdered: " & vbTab & ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex)
AddDebugLine "AmountDelivered: " & vbTab & ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex)
AddDebugLine "AmountScanned: " & vbTab & ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex)
ShowDebugBox "UpdateOrderDataBeforeDelNote"
End If
MacroFlag = CInt(ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex))
' Wenn Macro-Artikel nur zum Teil ausgeliefert werden,
' müssen die Anteile Nicht-scannbarer Artikel entsprechend reduziert werden.
If MacroFlag = 1 Then
MacroAmount = Cint(ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex)) - Cint(ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex))
MacroAmountScannend = Cint(ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex))
If MacroAmount > MacroAmountScannend Then
MacroComplete = False
If MacroAmount > 0 Then
MacroAmountFaktor = MacroAmountScannend / MacroAmount
End If
Else
MacroComplete = True
MacroAmountFaktor = 1
End If
ElseIf MacroFlag = 2 And MacroComplete = False Then
ProductGroup = Cint(ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex))
' Wir müssen nur etwas tun, wenn ein Faktor < 1 (=100%) ermittelt wurde,
' da die Artikel der ProductGroup aus den EXCLUDED_ARTICLEGROUPS ja bereits vollständig initialisiert werden.
If CheckArticleGroupIsRelevant(ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex)) = False And MacroAmountFaktor < 1 Then
ProductAmount = Cint(ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex)) - Cint(ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex))
ProductAmount = Round(ProductAmount * MacroAmountFaktor)
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = ProductAmount
End If
End If
Next
End Sub

91
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/AllocatePseudoSerialNumbers.vbm Normal file
View File

@@ -0,0 +1,91 @@
' AllocatePseudoSerialNumbers()
' ----------------------------------------------------------------------------
' Stellt Methoden für den Zugriff auf die Tabelle Packtisch bereit
'
' 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: 22.03.2022 / MP
' Version Number: 4.0.0.0
Function AllocatePseudoSerialNumbers(AuftragsNr, ArtikelNr, AmountToAllocate)
Set Conn = CWLStart.Connection
Err.Clear
Dim NowObject : NowObject = Now
Dim DateString : DateString = Year(NowObject) & "-" & GetLeftPad(Month(NowObject)) & "-" & GetLeftPad(Day(NowObject))
Dim TimeString : TimeString = GetLeftPad(Hour(NowObject)) & ":" & GetLeftPad(Minute(NowObject)) & ":" & GetLeftPad(Second(NowObject))
Dim RechnerName : RechnerName = GetWindowsEnvironment("COMPUTERNAME")
Dim AllocateSQL : AllocateSQL = ""
AllocateSQL = AllocateSQL & "select top " & AmountToAllocate & " c068 "
AllocateSQL = AllocateSQL & "from v021 (NOLOCK)"
AllocateSQL = AllocateSQL & "where c068 like '" & ArtikelNr & "-________-____' "
AllocateSQL = AllocateSQL & "and c038 is null "
AllocateSQL = AllocateSQL & "and (c008 - c009) = 1 "
AllocateSQL = AllocateSQL & "and c068 not in (SELECT PseudoSN from TBDD_PACKTISCH_HISTORY (NOLOCK) WHERE ArtikelNr = '" & ArtikelNr & "') "
AllocateSQL = AllocateSQL & SQLQuery_BasicWhere
AllocateSQL = AllocateSQL & " order by c068 asc"
Set Result = Conn.Select(AllocateSQL)
If DEBUG_ON = True Then
MsgBox "SQL:" & AllocateSQL, vbOkonly, DEBUG_TITLE
AddDebugLine "Searching For Order by OrderId (Mid Table).." & vbNewline & vbNewline
AddDebugLine "Result Columns: " & Result & vbNewline
AddDebugLine "Result Rows: " & Result.RowCount & vbNewline
AddDebugLine "AllocateSQL: " & AllocateSQL
ShowDebugBox "AllocatePseudoSerialNumbers"
End If
Dim PseudoArrayInternal()
PseudoArrayIndex = 0
Redim PseudoArrayInternal(AmountToAllocate)
If Result.RowCount < AmountToAllocate Then
Msgbox "Für Artikel " & ArtikelNr & " konnten nicht genug Pseudo-SN reserviert werden!", vbExclamation, DEFAULT_TITLE & " - AllocatePseudoSerialNumbers"
PseudoArrayInternal(0) = ""
AllocatePseudoSerialNumbers = PseudoArrayInternal
Exit Function
End If
Do: Do
PseudoSN = Result.Value("c068")
PseudoArrayInternal(PseudoArrayIndex) = PseudoSN
PseudoArrayIndex = PseudoArrayIndex + 1
InsertPacktischHistoryRow AuftragsNr, ArtikelNr, PseudoSN
Loop While False: Loop While Result.NextRecord = True
AllocatePseudoSerialNumbers = PseudoArrayInternal
End Function

237
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/ArticleExists.vbm Normal file
View File

@@ -0,0 +1,237 @@
' ArticleExists(Identifier: String)
' ----------------------------------------------------------------------------
' Findet Artikelnummer anhand von versch. Kriterien
' - Artikel-Nummer, Alternative Artikel-Nummer, EAN-Code, Seriennummer
' - Gibt die Zeile im Grid zurück in der Artikel das erste Mal gefunden wurde
'
' Returns: ArticleExists: Int
' ----------------------------------------------------------------------------
' 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: 01.09.2020 / JJ
' Version Date / Editor: 13.12.2021 / MP
' Version Number: 4.0.0.0
Const ARTICLE_EXISTS_NO_STOCK = -99
Const ARTICLE_EXISTS_NO_SERIALNUMBER = -98
Const ARTICLE_EXISTS_NO_ARTICLE_EAN = -97
Const ARTICLE_EXISTS_NO_REGEX_MATCH = -96
Const ARTICLE_EXISTS_OVERSCANNED = -95
Function ArticleExists(Identifier)
ArticleExists = 0
HasError = False
CURRENT_SERIALNUMBER = ""
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
' ===================== SERIENNUMMER =====================
' Zuerst prüfen wir, ob es ein Seriennummerartikel ist
Set ResultSeriennummer = GetSeriennummerRow(Identifier)
If ResultSeriennummer.RowCount > 0 Then
SerialNumberString = ResultSeriennummer.Value("C068")
MainArticleNumber = ResultSeriennummer.Value("C011")
SQL = ""
SQL = SQL & "(C002 = '" & MainArticleNumber & "') "
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set ResultMainArticle = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If ResultMainArticle.RowCount > 0 Then
' Default: ART_REGEX_FLDBEZ = C222
SerialNumberPattern = ResultMainArticle.Value(ART_REGEX_FLDBEZ)
End If
If DEBUG_ON = True Then
AddDebugLine "Preparing Regex Check. " & vbNewline
AddDebugLine "SerialNumberString: " & SerialNumberString
AddDebugLine "SerialNumberPattern: " & SerialNumberPattern
AddDebugLine "MainArticleNumber: " & MainArticleNumber
ShowDebugBox "ArticleExists"
End If
If Len(SerialNumberPattern) > 0 And Len(SerialNumberString) > 0 Then
Set SerialNumberRegex = New Regexp
With SerialNumberRegex
.Pattern = SerialNumberPattern
.IgnoreCase = False
.Global = False
End With
Set RegexMatch = SerialNumberRegex.Execute(SerialNumberString)
Set FirstMatch = RegexMatch.Item(0)
If DEBUG_ON = True Then
AddDebugLine "Checked Serialnumber against Regex. (1/2)" & vbNewline
AddDebugLine "FirstMatch.Length: " & FirstMatch.Length
AddDebugLine "Len(SerialNumberString): " & Len(SerialNumberString)
AddDebugLine "FirstMatch.FirstIndex: " & FirstMatch.FirstIndex
ShowDebugBox "ArticleExists"
End If
If Not (FirstMatch.Length = Len(SerialNumberString) And FirstMatch.FirstIndex = 0) Then
ArticleExists = ARTICLE_EXISTS_NO_REGEX_MATCH
HasError = True
End If
If DEBUG_ON = True Then
AddDebugLine "Checked Serialnumber against Regex. (2/2)" & vbNewline
AddDebugLine "Result: " & SerialNumberRegex.Test(SerialNumberString)
AddDebugLine "Serialnumber: " & SerialNumberString
AddDebugLine "Regex: " & SerialNumberPattern
ShowDebugBox "ArticleExists"
End If
End If
CURRENT_SERIALNUMBER = Identifier
Set Result = ResultSeriennummer
Else
' ===================== ARTIKEL NUMMER / EAN-CODE =====================
' Wenn es kein Ausprägeartikel ist, suchen wir im Artikelstamm
Set Result = GetArticleRow(Identifier)
End If
'==========================================================
If HasError = True Then
' Just skip the rest of the function and return the current error
Elseif Result.RowCount > 0 Then
' Wir brauchen die Hauptartikelnummer, weil die Prüfung sonst bei SN-Artikeln fehlschlägt
MainArticleNumber = Result.Value("C011")
RealArticleNumber = Result.Value("C002")
AmountStocked = GetWinLineStockedAmount(RealArticleNumber, False)
If DEBUG_ON = True Then
AddDebugLine "Checking stock of product: " & RealArticleNumber & " (" & MainArticleNumber & ")" & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "Stock: " & AmountStocked
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
If AmountStocked > 0 Then
If DEBUG_ON = True Then
AddDebugLine "Amount stocked: " & AmountStocked
End If
' Vorkommen in Tabelle prüfen
For GridLineIndex = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(GridLineIndex, COLUMN_ARTICLENUMBER)
Total = Cint(Grid.GetCellValue(GridLineIndex, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(GridLineIndex, COLUMN_SCANNED))
Amount = CInt(amountBox.ScreenContents)
If CurrentArticleNumber = MainArticleNumber Then
If DEBUG_ON = True Then
AddDebugLine "CurrentArticleNumber matches MainArticleNumber! (" & CurrentArticleNumber & ")"
End If
If Total > Scanned Then
If DEBUG_ON = True Then
AddDebugLine "Product is not yet scanned completely and exists in Row " & GridLineIndex & "!"
End If
If (Total - Scanned) >= Amount Then
ArticleExists = GridLineIndex
Exit For
Else
If GetCountInDuplList(CurrentArticleNumber) <= 1 Then
Exit For
End If
End If
Else
ArticleExists = ARTICLE_EXISTS_OVERSCANNED
End If
End If
Next
Else
If DEBUG_ON = True Then
AddDebugLine "Amount stocked: 0"
End If
ArticleExists = ARTICLE_EXISTS_NO_STOCK
End If
If DEBUG_ON = True Then
ShowDebugBox "ArticleExists"
End If
Else
If CURRENT_SERIALNUMBER = "" Then
ArticleExists = ARTICLE_EXISTS_NO_ARTICLE_EAN
Else
ArticleExists = ARTICLE_EXISTS_NO_SERIALNUMBER
End If
End If
End Function
Function GetSeriennummerRow(Identifier)
Set GetSeriennummerRow = Nothing
If Len(Identifier) > 0 Then
Set Conn = CWLStart.Connection
SQL = ""
SQL = SQL & " SELECT TOP 1 C002, C011, C068 "
SQL = SQL & " FROM T024 (NOLOCK) "
SQL = SQL & " WHERE C068 = '" & Identifier & "' "
SQL = SQL & " AND c038 IS NULL " ' Nur aktive Artikel
SQL = SQL & SQLQuery_BasicWhere
Set GetSeriennummerRow = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for Article by Article serial number " & vbNewline
AddDebugLine "Result Columns: " & GetSeriennummerRow
AddDebugLine "Result Rows: " & GetSeriennummerRow.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists - GetSeriennummerRow"
End If
End If
End Function
' Ruft Daten aus der Tabelle t024 ab, für Artikel OHNE Ausprägung
Function GetArticleRow(Identifier)
Set GetArticleRow = Nothing
If Len(Identifier) > 0 Then
Set Conn = CWLStart.Connection
SQL = ""
SQL = SQL & " SELECT TOP 1 C002, C011 "
SQL = SQL & " FROM T024 (NOLOCK) "
SQL = SQL & " WHERE (C002 = '" & Identifier & "' OR C075 = '" & Identifier & "' OR C114 = '" & Identifier & "' OR C115 = '" & Identifier & "') "
SQL = SQL & " AND c038 IS NULL " ' Nur aktive Artikel
SQL = SQL & SQLQuery_BasicWhere
Set GetArticleRow = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for Article by ArticleNo/EAN-Code.. " & vbNewline & vbNewline
AddDebugLine "Result Columns: " & GetArticleRow & vbNewline
AddDebugLine "Result Rows: " & GetArticleRow.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists - GetArticleRow"
End If
End If
End Function

82
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/CheckArticleGroupIsRelevant.vbm Normal file
View File

@@ -0,0 +1,82 @@
' CheckArticleGroupIsRelevant(ArticleGroup : Integer)
' ----------------------------------------------------------------------------
' Prüft, ob die übergebene Artikelgruppe am Packtisch bearbeitet/gescannt
' werden kann (true), oder ob es sich um eine "nicht-relevante" Artikelgruppe
' handelt (false), zb Versandkosten, die auf nicht sichtbar geschaltet wird.
'
' Geprüft wird gegen die Variable EXCLUDED_ARTICLEGROUPS, die im Fensterscript
' konfiguriert werden kann.
' Die Variable kann entweder genau einen Wert, einen unteren/oberen Grenzwert
' oder eine Liste von Werten enthalten.
' Erlaubte Beispiele:
' - Genau ein Wert: "100"
' - Grenzwert bis/ab dem dies gilt: "100-" / "100+"
' - Array von verschiedenen Werten: "100, 101, 102"
'
' Wenn keine Artikelgruppe als nicht-relevant definiert wurde oder die zu
' prüfende Artikelgruppe ist leer oder kleiner 1, wird True zurückgegeben.
'
' Returns: CheckArticlegroupIsRelevant : Boolean
' ----------------------------------------------------------------------------
' 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: 24.06.2021 / MP
' Version Date / Editor: 28.06.2021 / MP
' Version Number: 4.0.0.0
Function CheckArticleGroupIsRelevant(ArticleGroup)
CheckArticleGroupIsRelevant = True
' Wenn die Variable leer ist, sind alle Artikelgruppen relevant
If Len(EXCLUDED_ARTICLEGROUPS) <= 0 Then
Exit Function
End If
' Ohne Wert geht gar nichts, auch Negative Werte sind sinnlos
If Len(ArticleGroup) <= 0 Or ArticleGroup < 0 Then
CheckArticleGroupIsRelevant = False
Exit Function
End If
' Wenn EXCLUDED_ARTICLEGROUPS ein Komma enthält, muss ein Array
' aus den Elementen erzeugt werden.
posKomma = InStr(EXCLUDED_ARTICLEGROUPS, ",")
If posKomma > 0 Then
exValueArray = Split(EXCLUDED_ARTICLEGROUPS, ",")
For Each exValue in exValueArray
If Cint(exValue) = ArticleGroup Then
CheckArticleGroupIsRelevant = False
Exit Function
End If
Next
Else
posPlus = InStr(EXCLUDED_ARTICLEGROUPS, "+")
posMinus = InStr(EXCLUDED_ARTICLEGROUPS, "-")
If posPlus > 0 Then
' + enthalten, die Variable enthält ein unteres Limit
limit = CInt(Mid(EXCLUDED_ARTICLEGROUPS, 1, posPlus-1))
If ArticleGroup >= limit Then
CheckArticleGroupIsRelevant = False
End If
ElseIf posMinus > 0 Then
' - enthalten, die Variable enthält ein oberes Limit
limit = CInt(Mid(EXCLUDED_ARTICLEGROUPS, 1, posMinus-1))
If ArticleGroup <= limit Then
CheckArticleGroupIsRelevant = False
End If
Else
' Die Variable enthält genau eine Artikelgruppe
If ArticleGroup = CInt(EXCLUDED_ARTICLEGROUPS) Then
CheckArticleGroupIsRelevant = False
End If
End If
End If
End Function

65
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/CheckMacroArticlesComplete.vbm Normal file
View File

@@ -0,0 +1,65 @@
' CheckMacroArticlesComplete()
' ----------------------------------------------------------------------------
' Prüft, ob die im Auftrag enthaltenen Macro-Artikel
' vollständig sind, und vermerkt die Infos im
' MACRO_ARTICLE_LIST-Array
'
' 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: 08.03.2021 / MP
' Version Date / Editor: 08.03.2021 / MP
' Version Number: 4.0.0.0
Sub CheckMacroArticlesComplete()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
For GridIndex = 1 To Grid.LineCount: Do
MacroFlag = Cint(Grid.GetCellValue(GridIndex, COLUMN_MACRO_FLAG))
If MacroFlag = 1 Then
LineNumber = Cint(Grid.GetCellValue(GridIndex, COLUMN_LINE_NUMBER))
MacroArticleListIndex = -1
For MacroArrayIndex = 0 To UBound(MACRO_ARTICLE_LIST)
If MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_LINE_NUMBER, MacroArrayIndex) = LineNumber Then
MacroArticleListIndex = MacroArrayIndex
Exit For
End If
Next
For InnerGridIndex = GridIndex + 1 To Grid.LineCount: Do
InnerMacroFlag = Cint(Grid.GetCellValue(InnerGridIndex, COLUMN_MACRO_FLAG))
If InnerMacroFlag = 2 Then
AmountTotal = Cint(Grid.GetCellValue(InnerGridIndex, COLUMN_TOTAL))
AmountScanned = Cint(Grid.GetCellValue(InnerGridIndex, COLUMN_SCANNED))
If AmountTotal <> AmountScanned Then
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_GRID_LINE_INDEX, MacroArticleListIndex) = GridIndex
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_COMPLETE, MacroArticleListIndex) = False
' An der Stelle des unvollständigen Artikels weiter prüfen
GridIndex = InnerGridIndex
' Aus Makroartikel aussteigen, weil unvollständig
Exit For
End If
Else
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_GRID_LINE_INDEX, MacroArticleListIndex) = GridIndex
' An der Stelle des unvollständigen Artikels weiter prüfen
GridIndex = InnerGridIndex
' Aus Makroartikel aussteigen, weil vollständig
Exit For
End If
Loop While False: Next
Else
' Nächsten Artikel bearbeiten
Exit Do
End If
Loop While False: Next
End Sub

51
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/CheckOrderIsLocked.vbm Normal file
View File

@@ -0,0 +1,51 @@
' CheckOrderIsLocked(OrderNumber : String)
' ----------------------------------------------------------------------------
' Prüft, ob der Auftrag gesperrt ist.
' Wenn der Auftrag gesperrt ist, wird der Anwender informiert,
' wer die Sperre hält, und ob man es erneut versuchen möchte,
' oder Abbrechen will. Das Verhalten orientiert sich an der
' Vorlage, wie die Winline auf solche Sperrren reagiert.
'
' Returns: CheckOrderIsLocked : Boolean
' ----------------------------------------------------------------------------
' 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: 07.04.2021 / MP
' Version Date / Editor: 07.04.2021 / MP
' Version Number: 4.0.0.0
Function CheckOrderIsLocked(OrderNumber)
CheckOrderIsLocked = False
If Len(OrderNumber) <= 0 Then
' Ohne Auftrag geht gar nichts
Exit Function
End If
Dim ContinueFlag : ContinueFlag = True
Do
UserId = IsOrderLocked(OrderNumber)
If UserId > 0 Then
CheckOrderIsLocked = True ' Rückgabewert
QuestionText = "Der Auftrag [" & OrderNumber & "] wird von Benutzr [" & GetWinLineUserData(UserID) & "] bearbeitet! " & vbNewLine & vbNewLine
Answer = MsgBox(QuestionText & "Wollen Sie abbrechen?", vbYesno + vbQuestion, DEFAULT_TITLE & " - CheckOrderIsLocked")
If Answer = vbYes Then
ContinueFlag = False ' Abbrechen
Else
ContinueFlag = True ' Weiter prüfen
End If
Else
CheckOrderIsLocked = False ' Rückgabewert
ContinueFlag = False
End If
Loop While ContinueFlag = true
End Function

410
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/CompleteOrder.vbm Normal file
View File

@@ -0,0 +1,410 @@
' CompleteOrder()
' ----------------------------------------------------------------------------
' Schließt die Prüfung ab und erstellt einen Lieferschein
'
' Returns: CompleteOrder : Boolean
' ----------------------------------------------------------------------------
' 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: 01.09.2020 / JJ
' Version Date / Editor: 01.06.2023 / JJ/MP
' Version Number: 4.1.0.0
Function CompleteOrder()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Conn = CWLStart.CurrentCompany.Connection
Set Grid = mywin.Controls.Item(GRID_ID).Grid
If MACRO_ARTICLE_COUNTER > 0 Then
Dim MacroArticleReseted : MacroArticleReseted = False
CheckMacroArticlesComplete()
For MacroArrayIndex = 0 To Ubound(MACRO_ARTICLE_LIST, 2)
If (MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_COMPLETE, MacroArrayIndex) = False) AND _
(MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_SCAN_FLAG, MacroArrayIndex) = True) Then
questionText = "Der Package-Artikel [" & MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_NUMBER, MacroArrayIndex) & "] ist unvollständig!" & vbNewLine & vbNewLine
Answer = MsgBox(questionText & "Soll das gesamte Package zurückgesetzt werden?", vbYesno + vbQuestion, DEFAULT_TITLE)
If Answer = vbYes Then
ResetValuesByMacroLineNumber MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_LINE_NUMBER, MacroArrayIndex)
MacroArticleReseted = True
Else
CompletedPackages = Cint(InputBox("Wieviele Package-Artikel von insgesamt [" & MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_REMAINING, MacroArrayIndex) & "] werden damit ausgeliefert?", "Anzahl fertige Packages", "0"))
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED, MacroArrayIndex) = CompletedPackages
End If
End If
If (MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_COMPLETE, MacroArrayIndex) = True) Then
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED, MacroArrayIndex) = MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_REMAINING, MacroArrayIndex)
End If
Next
If MacroArticleReseted = True Then
Answer = MsgBox("Einer oder mehrere Package-Artikel wurden zurückgesetzt. Soll die Lieferscheinerstellung abgebrochen werden?", vbYesno + vbQuestion, DEFAULT_TITLE)
If Answer = vbYes Then
CompleteOrder = False
Exit Function
End If
End If
' Übertrage Macro-Daten zurück ins Grid
TransferMacroData()
End If
' Übertrage die Grid-Daten zurück in die Order-Datenstruktur
TransferGridData()
' Eine letzte Möglichkeit die Auftragsdaten zu tunen
UpdateOrderDataBeforeDelNote()
Dim OrderId, AccountSQL, MandatorId, RunningNumber
If DEBUG_ON = True Then
AddDebugLine "Completing order.. " & vbNewline
ShowDebugBox "CompleteOrder"
End If
OrderId = mywin.Controls.Item(ORDER_INPUT).ScreenContents
AccountSQL = "SELECT DISTINCT c021 FROM t025 (NOLOCK) WHERE c044 = '" & OrderId & "' " & SQLQuery_OrderWhere
Set AccountResult = Connection.Select(AccountSQL)
If DEBUG_ON = True Then
AddDebugLine "Querying for CustomerAccountId.. " & vbNewline
AddDebugLine "Result Columns: " & AccountResult
AddDebugLine "Result Rows: " & AccountResult.RowCount
AddDebugLine "SQL: " & AccountSQL
ShowDebugBox "CompleteOrder"
End If
MandatorId = AccountResult.Value("c021")
RunningNumber = RUNNING_NUMBER_PREFIX & OrderId
BelegKey = Cstr(DateDiff("s", "01/01/1970 00:00:00", Now))
' ===================== KOPFDATEN =====================
Dim Request, URL, XML
Dim NowObject : NowObject = Now
Dim DateString : DateString = Year(NowObject) & "-" & GetLeftPad(Month(NowObject)) & "-" & GetLeftPad(Day(NowObject))
Dim TimeString : TimeString = GetLeftPad(Hour(NowObject)) & ":" & GetLeftPad(Minute(NowObject)) & ":" & GetLeftPad(Second(NowObject))
Dim UserNumber : UserNumber = Cwlstart.Currentuser.Number
Dim ComputerName : ComputerName = GetWindowsEnvironment("COMPUTERNAME")
' === WEB SERVICES =======================
XML = ""
XML = XML & "<?xml version=""1.0"" encoding=""UTF-8""?>"
XML = XML & "<MESOWebService TemplateType=""__TYPE__"" Template=""__VORLAGE__"" option=""__OPTION__"" printVoucher=""__PRINT__"">"
XML = XML & "<__VORLAGE__T025>"
XML = XML & "<BELEGKEY>" & BelegKey & "</BELEGKEY>"
XML = XML & "<Kontonummer>" & MandatorId & "</Kontonummer>"
XML = XML & "<Laufnummer>" & RunningNumber & "</Laufnummer>"
XML = XML & "<Auftragsnummer>" & OrderId & "</Auftragsnummer>"
XML = XML & "<Datum_Lieferschein>" & DateString & "</Datum_Lieferschein>"
If USE_ADDITIONAL_DBFIELDS = True Then
XML = XML & "<BenutzerNummerPacktisch>" & UserNumber & "</BenutzerNummerPacktisch>"
XML = XML & "<ErstellDatumPacktisch>" & DateString & " " & TimeString & "</ErstellDatumPacktisch>"
XML = XML & "<ComputerNamePacktisch>" & ComputerName & "</ComputerNamePacktisch>"
XML = XML & "<VersionPacktisch>" & PACKTISCH_VERSION & "</VersionPacktisch>"
End If
XML = XML & "</__VORLAGE__T025>"
' === EXIM TABELLE =======================
HeadSQL = "INSERT INTO " & SQLDB_for_EXIM & "." & SQLHeadTB_for_EXIM & " "
HeadSQL = HeadSQL & "(BELEGKEY, Kontonummer, Laufnummer, Auftragsnummer, Belegdatum) "
HeadSQL = HeadSQL & "VALUES("& BelegKey &", '"& MandatorId &"', '"& RunningNumber &"', '"& OrderId &"', GETDATE())"
HeadResult = Conn.ExecuteSQL(HeadSQL)
If DEBUG_ON = True Then
AddDebugLine "Inserting Head Data" & vbNewline
AddDebugLine "Result: " & HeadResult
AddDebugLine "SQL: " & HeadSQL
ShowDebugBox "CompleteOrder"
End If
' ===================== ENDE KOPFDATEN =====================
' ============================ MITTEDATEN ============================
Dim ArticleNumber, AmountScanned, SerialNumber, StorageLocation, LineNumber
For OrderArrayIndex = 0 To Ubound(ORDER_ARTICLE_DATA, 2): Do
IsSerialNumberArticle = Cint(ORDER_ARTICLE_DATA(INDEX_IS_SERIAL_NUMBER, OrderArrayIndex))
ArticleNumber = ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex)
SerialNumber = ORDER_ARTICLE_DATA(INDEX_SERIAL_NUMBER, OrderArrayIndex)
PseudoSN = ORDER_ARTICLE_DATA(INDEX_PSEUDO_SN, OrderArrayIndex)
AmountScanned = CInt(ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex))
LineNumber = CInt(ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex))
DataType = CInt(ORDER_ARTICLE_DATA(INDEX_DATA_TYPE, OrderArrayIndex))
VKPreisEinzel = Replace(ORDER_ARTICLE_DATA(INDEX_PRICE_VK_EINZEL, OrderArrayIndex), ",", ".")
IsOpen = ORDER_ARTICLE_DATA(INDEX_IS_OPEN, OrderArrayIndex)
' Sonderfall Artikel mit negativen Mengen
If (ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) - ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex)) < 0 Then
AmountScanned = ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex)
IsOpen = True
End If
If DEBUG_ON = True Then
AddDebugLine "Processing Article: " & ArticleNumber
AddDebugLine "SerialNumber: " & SerialNumber
AddDebugLine "PseudoSN: " & PseudoSN
AddDebugLine "LineNumber: " & LineNumber
AddDebugLine "DataType: " & DataType
AddDebugLine "IsOpen: " & IsOpen
ShowDebugBox "CompleteOrder - MITTEDATEN"
End If
' Text-Artikel werden nicht übergeben
If DataType = 3 Then
Exit Do
End If
' Artikeldaten abhängig von PseudoSN laden
If Len(PseudoSN) = 0 Then
StorageLocation = GetWinLineStorageLocation(ArticleNumber, SerialNumber, IsSerialNumberArticle)
InternalArticleNumber = GetWinLineInternalProductNumber(ArticleNumber, SerialNumber)
Else
StorageLocation = GetWinLineStorageLocation(ArticleNumber, PseudoSN, IsSerialNumberArticle)
InternalArticleNumber = GetWinLineInternalProductNumber(ArticleNumber, PseudoSN)
End If
' Lock Tabelle updaten, PseudoNr-Positionen vorbereiten, wenn die Position gescannt wurde
If IsSerialNumberArticle = 1 And Len(SerialNumber) > 0 Then
If DEBUG_ON = True Then
AddDebugLine "OrderArrayIndex: " & OrderArrayIndex
AddDebugLine "PseudoSN: " & PseudoSN
AddDebugLine "SerialNumber: " & SerialNumber
ShowDebugBox "CompleteOrder - UpdatePacktischHistoryRow"
End If
UpdatePacktischHistoryRow OrderId, ArticleNumber, PseudoSN, "Scanned", SerialNumber
End If
' === EXIM TABELLE =======================
MidSQL = "INSERT INTO " & SQLDB_for_EXIM & "." & SQLMiddleTB_for_EXIM & " "
MidSQL = MidSQL & "(BELEGKEY, Artikelnummer, Hauptartikelnummer, Zeilennummer, Datentyp, Mengegeliefert, ChargeIdentnummer, Lagerort, Einzelpreis) "
MidSQL = MidSQL & "VALUES (" & BelegKey & ", '" & ArticleNumber & "', '" & ArticleNumber & "', "
If IsSerialNumberArticle = 1 Then
MidSQL = MidSQL & LineNumber
Else
MidSQL = MidSQL & " NULL"
End If
MidSQL = MidSQL & ", '1', " & AmountScanned & ", '" & SerialNumber & "', " & StorageLocation& ", " & VKPreisEinzel & ")"
MidResult = Conn.ExecuteSQL(MidSQL)
' === WEB SERVICES =======================
MidXML = ""
' Abgeschlossene Belegzeilen werden nicht an den WebService übergeben
If IsOpen = True Then
MidXML = MidXML & "<__VORLAGE__T026>"
MidXML = MidXML & "<BELEGKEY>" & BelegKey & "</BELEGKEY>"
MidXML = MidXML & "<Artikelnummer>" & InternalArticleNumber & "</Artikelnummer>"
MidXML = MidXML & "<Hauptartikelnummer>" & ArticleNumber & "</Hauptartikelnummer>"
MidXML = MidXML & "<Zeilennummer>" & LineNumber & "</Zeilennummer>"
MidXML = MidXML & "<Datentyp>" & "1" & "</Datentyp>"
MidXML = MidXML & "<Mengegeliefert>" & AmountScanned & "</Mengegeliefert>"
MidXML = MidXML & "<ChargeIdentnummer>" & SerialNumber & "</ChargeIdentnummer>"
MidXML = MidXML & "<Lagerort>" & StorageLocation & "</Lagerort>"
MidXML = MidXML & "<Einzelpreis>" & VKPreisEinzel & "</Einzelpreis>"
MidXML = MidXML & "</__VORLAGE__T026>"
End If
If DEBUG_ON = True Then
AddDebugLine "Inserting Middle Data" & vbNewline
AddDebugLine "For Article " & ArticleNumber
AddDebugLine "And Amount " & AmountScanned
AddDebugLine "Result: " & MidResult & vbNewline
AddDebugLine "SQL: " & MidSQL & vbNewline
AddDebugLine "XML: " & MidXML
ShowDebugBox "CompleteOrder - XML"
End If
XML = XML & MidXML
Loop While False: Next
XML = XML & "</MESOWebService>"
XML = Replace(XML, "__VORLAGE__", WEB_VORLAGE)
XML = Replace(XML, "__TYPE__", WEB_TYPE)
XML = Replace(XML, "__PRINT__", WEB_PRINT)
XML = Replace(XML, "__OPTION__", WEB_OPTION)
If USE_WEBSERVICE_WITH_FILES = True Then
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
BasePath = CWLStart.CurrentCompany.Value(MDFLDNO_MODULE_PATH)
FileName = BelegKey & ".xml"
AbsoluteImportPath = BasePath & "\..\" & RELATIVE_IMPORT_PATH
AbsoluteImportPath = CreateDateDirectory(AbsoluteImportPath)
RelativeImportFilePath = RELATIVE_IMPORT_PATH & "\" & GetRelativDateDirectoryName() & "\" & FileName
AbsoluteImportFilePath = AbsoluteImportPath & "\" & FileName
If DEBUG_ON = True Then
AddDebugLine "Creating Absolute Path"
AddDebugLine "AbsoluteImportPath: " & AbsoluteImportPath
AddDebugLine "RelativeImportFilePath: " & RelativeImportFilePath
AddDebugLine "AbsoluteImportFilePath: " & AbsoluteImportFilePath
ShowDebugBox "CompleteOrder"
End If
If FSO.FolderExists(AbsoluteImportPath) = False Then
MsgBox("Import Pfad [" & AbsoluteImportPath & "] existiert nicht. Import wird abgebrochen.")
CompleteOrder = False
Exit Function
End If
Set OutPutFile = FSO.OpenTextFile(AbsoluteImportFilePath, 2, True)
OutPutFile.WriteLine(XML)
If DEBUG_ON = True Then
AddDebugLine "Writing XML File:"
AddDebugLine "SUCCESS"
ShowDebugBox "CompleteOrder"
End If
Set FSO = Nothing
' Import mit Datei
WEB_BYREF = 1
WEB_DATA = RelativeImportFilePath
Else
' Import per URL
WEB_BYREF = 0
WEB_DATA = XML
End If
URL = "http://__SERVER__/ewlservice/import?User=__USER__&Password=__PASSWORD__&Company=__COMPANY__&Type=30&Vorlage=__VORLAGE__&Actioncode=__ACTIONCODE__&byref=__BYREF__&Data=__DATA__"
URL = Replace(URL, "__SERVER__", WEB_SERVER)
URL = Replace(URL, "__USER__", WEB_USER)
URL = Replace(URL, "__PASSWORD__", WEB_PASS)
URL = Replace(URL, "__COMPANY__", WEB_COMPANY)
URL = Replace(URL, "__VORLAGE__", WEB_VORLAGE)
URL = Replace(URL, "__BYREF__", WEB_BYREF)
URL = Replace(URL, "__ACTIONCODE__", WEB_ACTIONCODE)
URL = Replace(URL, "__DATA__", WEB_DATA)
' ======================= ENDE MITTEDATEN =======================
' Pseudo-SN mit echter SN im Artikelstamm ersetzen
If ReplacePseudoSerialNumbers(OrderId, "Scanned") = False Then
' Wenn beim Ersetzen ein Fehler auftritt,
' wird die Verarbeitung dieses Auftrags abgebrochen.
MsgBox("Es ist ein Fehler beim Verarbeiten der Seriennummern aufgetreten. Import wird abgebrochen.")
CompleteOrder = False
Exit Function
End If
' ===================== HTTP REQUEST =====================
If DEBUG_ON = True Then
AddDebugLine "Sending Request to WebServices.."
AddDebugLine "URL: " & URL
AddDebugLine "WEB_PRINT: " & WEB_PRINT
AddDebugLine "WEB_OPTION: " & WEB_OPTION
ShowDebugBox "CompleteOrder"
End If
Dim ReturnValue
ReturnValue = SendWebserviceRequest(URL)
Success = ReturnValue(0)
Message = ReturnValue(1)
' ===================== ABSCHLUSS =====================
If Success = True Then
UpdatePacktischHistoryRowsAfterSuccess(OrderId)
DeletePacktischHistoryRows()
MsgBox Message, vbInformation, DEFAULT_TITLE
CompleteOrder = True
Else
' Positionen wieder auf Pseudo-SN zurücksetzen
ReplacePseudoSerialNumbers OrderId, "Replaced"
MsgBox Message, vbExclamation, DEFAULT_TITLE & " - Fehler bei Abschluss"
CompleteOrder = False
End If
End Function
Function SendWebserviceRequest(URL)
Dim ReturnValue
Set Request = CreateObject("MSXML2.XMLHTTP")
' Open Request Object
On Error Resume Next
Request.Open "POST", URL, False
If Err.Number > 0 Then
ReturnValue = Array(False, "Abfrageobjekt für Webservice konnte nicht geöffnet werden")
SendWebserviceRequest = ReturnValue
Exit Function
End If
On Error Goto 0
' Send Request
On Error Resume Next
Request.Send
If Err.Number > 0 Then
ReturnValue = Array(False, "Webserviceanfrage konnte nicht gesendet werden!")
SendWebserviceRequest = ReturnValue
Exit Function
End If
On Error Goto 0
Response = Request.ResponseText
Status = Request.Status
If DEBUG_ON = True Then
AddDebugLine "Response from WebServices!"
AddDebugLine "Status: " & Status
AddDebugLine "Body: " & Response
ShowDebugBox "CompleteOrder"
End If
' =================== ENDE HTTP REQUEST ==================
If Status = 200 Then
If TestIsWebserviceResponseSuccessful(Response) = True Then
ReturnValue = Array(True, "Lieferschein wurde übertragen!")
SendWebserviceRequest = ReturnValue
Else
Message = "Lieferschein wurde nicht übertragen! Fehlerdetails: " & vbNewline & vbNewline & Response
ReturnValue = Array(False, Message)
SendWebserviceRequest = ReturnValue
End If
Else
Message = "Fehler beim Zugriff auf Webservices aufgetreten!" & vbNewline & vbNewline & "Status: " & Status
ReturnValue = Array(False, Message)
SendWebserviceRequest = ReturnValue
Error = True
End If
End Function

35
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/CountRowsForArticle.vbm Normal file
View File

@@ -0,0 +1,35 @@
' CountRowsForArticle(ArticleNumber : String)
' ----------------------------------------------------------------------------
' Gibt die Anzahl der Zeilen zu einer Artikelnummer zurück
'
' Returns: CountRowsForArticle : Int
' ----------------------------------------------------------------------------
' 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: 25.09.2020 / JJ
' Version Date / Editor: 25.09.2020 / JJ
' Version Number: 4.0.0.0
Function CountRowsForArticle(ArticleNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Dim Count : Count = 0
If DEBUG_ON = True Then
AddDebugLine "Counting rows for Article: " & ArticleNumber
ShowDebugBox "CountRowsForArticle"
End If
For GridIndex = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(GridIndex, COLUMN_ARTICLENUMBER)
If ArticleNumber = CurrentArticleNumber Then
Count = Count + 1
End If
Next
CountRowsForArticle = Count
End Function

392
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/DuplicateArticles.vbm Normal file
View File

@@ -0,0 +1,392 @@
' DuplicateArticles (ArticleNumber : String, MacroFlag : Int, ChargeFlag : Int)
' ----------------------------------------------------------------------------
' Funktionen zur Behandlung mehrfach vorkommender
' Artikelnummern. Daten werden im Array DUPL_ARTICLE_LIST
' gespeichert und verwaltet.
'
' 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: 15.04.2021 / MP
' Version Date / Editor: 15.04.2021 / MP
' Version Number: 4.0.0.0
Const ARTICLE_IS_NOT_IN_DUPLICATES_LIST = -199
Const GRIDLINE_INDEX_IS_NOT_CHOOSEABLE = -198
Const NO_GRIDLINE_INDEX_CHOSEN = -197
CONST USE_ORIGINAL_ROW = -196
' Legt für jeden scannbaren Artikel einen Satz in der Duplikate-Struktur an
' und zählt wie oft dieser Artikel vorkommt.
' Für Artikel innerhalb eines Macros wird zusätzlich ein eigener Zähler hochgesetzt.
Sub AddArticleNumberToDuplList(ArticleNumber, MacroFlag, ChargeFlag)
DuplArrayIndex = ExistArticleInDuplList(ArticleNumber)
If DuplArrayIndex = ARTICLE_IS_NOT_IN_DUPLICATES_LIST Then
' Lege neue Zeile an
AddTwoDimArrayRow DUPL_ARTICLE_LIST
DuplArrayIndex = UBound(DUPL_ARTICLE_LIST, 2)
DUPL_ARTICLE_LIST(COLUMN_DUPL_ARTICLE_NUMBER, DuplArrayIndex) = ArticleNumber
DUPL_ARTICLE_LIST(COLUMN_DUPL_CHARGE_FLAG, DuplArrayIndex) = ChargeFlag
DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex) = 1
DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex) = 0
If (MacroFlag = 2) Then
DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex) = 1
End If
DUPL_ARTICLE_LIST(COLUMN_DUPL_GRID_LINE_INDEXE, DuplArrayIndex) = ""
Else
' Erhöhe Wert in bestehender Zeile
currentValue = DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex)
DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex) = currentValue + 1
If (MacroFlag = 2) Then
currentMacroValue = DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex)
DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex) = currentMacroValue + 1
End If
End If
End Sub
' Reduziert die Zähler für den Artikel, wenn eine Zeile vollständig gescannt wurde.
' Für Macro-Unterteile wird zusätzlich der MacroCounter reduziert
Sub ReduceCounterInDuplList(ArticleNumber, MacroFlag)
DuplArrayIndex = ExistArticleInDuplList(ArticleNumber)
If DuplArrayIndex >= 0 Then
' Vermindert Wert für den Artikel
currentValue = DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex)
DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex) = currentValue - 1
If (MacroFlag = 2) Then
currentMacroValue = DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex)
DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex) = currentMacroValue - 1
End If
End If
End Sub
' Reduziert die Zähler im Sub-Macro-Artikel-Token, wenn eine Zeile vollständig gescannt wurde.
' benötigt die ZeilenNummer des Macro Artikels
Sub ReduceSubMacroCounterInDuplList(ArticleNumber, MacroLineNumber)
DuplArrayIndex = ExistArticleInDuplList(ArticleNumber)
If DuplArrayIndex >= 0 Then
TestToken = "#" & MacroLineNumber & ","
CurrentMacroLineNumbers = DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_LINE_NUMBERS, DuplArrayIndex)
If Len(CurrentMacroLineNumbers) > 0 And InStr(CurrentMacroLineNumbers, TestToken) > 0 Then
'Counter reduzieren!
TempMacroLineNumbers = ""
SplittedTokens = Split(CurrentMacroLineNumbers)
For Each Token In SplittedTokens
If (InStr(Token, TestToken) > 0) Then
'Treffer, Counter auslesen, erhöhen und zurückschreiben
TempToken = Split(Token, ",")
TokenLen = Len(TempToken(1))-1
NewCount = CInt(Left(TempToken(1), TokenLen)) - 1
If NewCount > 0 Then
TempMacroLineNumbers = TempMacroLineNumbers & " " & TestToken & NewCount & "#"
End If
Else
' Kein Treffer, Token wieder zurückschreiben
TempMacroLineNumbers = TempMacroLineNumbers & " " & Token
End If
Next
CurrentMacroLineNumbers = TempMacroLineNumbers
End If
DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_LINE_NUMBERS, DuplArrayIndex) = CurrentMacroLineNumbers
End If
End Sub
' Ergänzt die GridLine-Indexe für Artikel, die mehrfach vorkommen
' Bedingung: Der Artikel muss bereits in der Duplicate-Struktur
' enthalten sein, und einen Counter > 1 haben.
Sub AddGridLineIndexToDuplicateArticles(ArticleNumber, GridLineIndex)
DuplArrayIndex = ExistArticleInDuplList(ArticleNumber)
If DuplArrayIndex >= 0 Then
DuplCount = DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex)
If DuplCount > 1 Then
CurrentGridLineIndexe = DUPL_ARTICLE_LIST(COLUMN_DUPL_GRID_LINE_INDEXE, DuplArrayIndex)
If Len(CurrentGridLineIndexe) > 0 Then
CurrentGridLineIndexe = CurrentGridLineIndexe & " " & FormatNumber(GridLineIndex, 0)
Else
CurrentGridLineIndexe = FormatNumber(GridLineIndex, 0)
End If
DUPL_ARTICLE_LIST(COLUMN_DUPL_GRID_LINE_INDEXE, DuplArrayIndex) = CurrentGridLineIndexe
End If
End If
End Sub
' Ergänzt die LineNumber der Macro-Hauptartikel für Macro-Sub-Artikel
' Gesammelt werden Tokens in der Form #LN,1#, wenn sie noch nicht vorkommen.
' Der Counter wird hochgezählt, um das Vorkommen des Artikels in verschiedenen Macros abzufangen
' Bedingung: Der Artikel muss bereits in der Duplicate-Struktur
' enthalten sein, und einen Counter > 1 haben.
Sub AddMacroLineNumberTokensToDuplicateArticles(ArticleNumber, MacroLineNumber)
DuplArrayIndex = ExistArticleInDuplList(ArticleNumber)
If DuplArrayIndex >= 0 Then
DuplCount = DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex)
If DuplCount > 1 Then
TestToken = "#" & MacroLineNumber & ","
CurrentMacroLineNumbers = DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_LINE_NUMBERS, DuplArrayIndex)
If Len(CurrentMacroLineNumbers) <= 0 Then
CurrentMacroLineNumbers = TestToken & "1#"
ElseIf InStr(CurrentMacroLineNumbers, TestToken) = 0 Then
CurrentMacroLineNumbers = CurrentMacroLineNumbers & " " & TestToken & "1#"
Else
'Counter erhöhen!
TempMacroLineNumbers = ""
SplittedTokens = Split(CurrentMacroLineNumbers)
For Each Token In SplittedTokens
If (InStr(Token, TestToken) > 0) Then
'Treffer, Counter auslesen, erhöhen und zurückschreiben
TempToken = Split(Token, ",")
TokenLen = Len(TempToken(1))-1
NewCount = CInt(Left(TempToken(1), TokenLen)) + 1
TempMacroLineNumbers = TempMacroLineNumbers & " " & TestToken & NewCount & "#"
Else
' Kein Treffer, Token wieder zurückschreiben
TempMacroLineNumbers = TempMacroLineNumbers & " " & Token
End If
Next
CurrentMacroLineNumbers = TempMacroLineNumbers
End If
DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_LINE_NUMBERS, DuplArrayIndex) = CurrentMacroLineNumbers
End If
End If
End Sub
' Prüfe, ob eine Artikelnummer bereits in dem Array enthalten ist
' oder nicht
' Rueckgabewert: Index des Artikels im Array, wenn bereits vorhande, sonst -1 falls nicht vorhanden
Function ExistArticleInDuplList(ArticleNumber)
ExistArticleInDuplList = ARTICLE_IS_NOT_IN_DUPLICATES_LIST
If (UBound(DUPL_ARTICLE_LIST, 2) > -1) Then
For DuplArrayIndex = 0 To UBound(DUPL_ARTICLE_LIST, 2)
If (DUPL_ARTICLE_LIST(COLUMN_DUPL_ARTICLE_NUMBER, DuplArrayIndex) = ArticleNumber) Then
ExistArticleInDuplList = DuplArrayIndex
Exit For
End If
Next
End If
End Function
' Zählt die MacroLineNumber-Tokens für den Artikel, und gibt
' die Anzahl zurück
Function GetMacroLineNumberCount(DuplArrayIndex)
Count = 0
SplittetTokens = Split(Trim(DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_LINE_NUMBERS, DuplArrayIndex)))
For Each Element In SplittetTokens
Count = Count + 1
Next
GetMacroLineNumberCount = Count
End Function
' Die Funktion gibt die Anzahl der Vorkommen des Artikels zurück.
' Für Macro-Sub-Artikel wird noch der Macro-Counter ausgewertet
Function GetCountInDuplList(ArticleNumber)
GetCountInDuplList = 0
For DuplArrayIndex = 0 To UBound(DUPL_ARTICLE_LIST, 2)
If (DUPL_ARTICLE_LIST(COLUMN_DUPL_ARTICLE_NUMBER, DuplArrayIndex) = ArticleNumber) Then
' COLUMN_DUPL_ROW_COUNT enthält die Gesamtzahl der Vorkommen
DuplCounter = DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex)
If (DuplCounter > 1) Then
' Wenn mehr als 1 Zeile übrig ist und es ein SN-Artikel ist, müssen wir genauer prüfen,
' ob wir die Auswahlbox anzeigen sollen.
ChargeFlag = DUPL_ARTICLE_LIST(COLUMN_DUPL_CHARGE_FLAG, DuplArrayIndex)
If (ChargeFlag = 2) Then
' Gibt es noch SN-Artikel in Makros? und in wievielen unterschiedlichen Macros?
macroRowCounter = cint(DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex)) ' Anzahl Artikel innerhalb von Macros
macroLineCounter = cint(GetMacroLineNumberCount(DuplArrayIndex)) ' Anzahl unterschiedlicher Macros
' Die Abfragebox muss kommen, wenn
' a) SN-Artikel in mehreren unterschiedlichen Macros vorkommen
' b) SN-Artikel innerhalb und ausserhalb von Macros vorkommen
' --> Wir geben die komplette Menge DuplCounter zurück!
' Die Box darf nicht kommen, wenn
' c) wenn SN-Artikel nur ausserhalb von Macros vorkommen
' d) SN-Artikel nur noch in einem Bereich auftauchen,
' --> Wir geben 1 als DuplCounter zurück!
If (macroLineCounter = 0 OR _
(macroLineCounter = 1 AND DuplCounter = macroRowCounter)) Then
DuplCounter = 1
End If
End If
End If
GetCountInDuplList = DuplCounter
Exit For
End If
Next
End Function
' Funktion, die die gewählte Auswahl der InputBox auswertet
' Rückgabewert: gewählte Zeilennummer oder Fehler
Function ChooseGridLineIndexFromDuplicates(ArticleNumber)
NoValidIndexSelected = True
ChooseGridLineIndexFromDuplicates = -1
Do
RetValue = ShowDuplicateInputBox(ArticleNumber)
If RetValue = ARTICLE_IS_NOT_IN_DUPLICATES_LIST Then
' Der Artikel kommt nicht im Array vor. Abbruch.
NoValidIndexSelected = False
ChooseGridLineIndexFromDuplicates = -1
ElseIf RetValue = USE_ORIGINAL_ROW Then
' Verwende einfach die schon gefundene Zeile
NoValidIndexSelected = False
ChooseGridLineIndexFromDuplicates = USE_ORIGINAL_ROW
ElseIf RetValue = NO_GRIDLINE_INDEX_CHOSEN Then
' Leere Auswahl oder Abbruch - OK
Answer = MsgBox("Wollen Sie die Scanergebnisse für Artikel [" & ArticleNumber & "] wirklich verwerfen?", vbYesno + vbQuestion, DEFAULT_TITLE)
If Answer = vbYes Then
NoValidIndexSelected = False
ChooseGridLineIndexFromDuplicates = -1
End If
ElseIf RetValue > 0 Then
' Gültiger Wert wurde ausgewählt
NoValidIndexSelected = False
ChooseGridLineIndexFromDuplicates = RetValue
Else
' Falsche Auswahl - Erneut die InputBox anzeigen.
MsgBox "Die gewählte Zeile steht nicht zur Auswahl. Bitte wählen Sie erneut.", vbOKOnly + vbExclamation, DEFAULT_TITLE
End If
Loop While NoValidIndexSelected
End Function
' Die Funktion zeigt eine InputBox mit den Informationen über
' doppelte Artikel.
' Rückgabewert: GridLineIndex der Position die bebucht werden soll
Function ShowDuplicateInputBox(ArticleNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
ScannedAmount = Cint(amountBox.Contents)
DuplArrayIndex = ExistArticleInDuplList(ArticleNumber)
If (DuplArrayIndex < 0) Then
ShowDuplicateInputBox = ARTICLE_IS_NOT_IN_DUPLICATES_LIST
Exit Function
End If
ChargeFlag = DUPL_ARTICLE_LIST(COLUMN_DUPL_CHARGE_FLAG, DuplArrayIndex)
If ChargeFlag = 2 Then
' Anzeige für SN-Artikel macht nur Sinn, wenn Macro-Artikel involviert sind.
If DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex) <= 0 Then
ShowDuplicateInputBox = USE_ORIGINAL_ROW
Exit Function
End If
End If
Dim ChooseableTokens : ChooseableTokens = "" 'Enthält die erlaubten Werte für die Auswahl
Dim AlreadyUsedAreasTokens : AlreadyUsedAreasTokens = "" ' #0# = Normaler Artikel, sonst MacroLineIndex
Dim InputTitle : InputTitle = DEFAULT_TITLE & " - Auswahl einer Zeilennummer"
Dim InputDefault : InputDefault = "" ' Hier machen wir bewusst nichts!
InputPrompt = "Der Artikel [" & ArticleNumber & "] kommt mehrfach im Auftrag vor: " & vbNewLine & vbNewLine
SplittetValues = Split(DUPL_ARTICLE_LIST(COLUMN_DUPL_GRID_LINE_INDEXE, DuplArrayIndex))
For Each GridLineIndex In SplittetValues : Do
Total = Cint(Grid.GetCellValue(Cint(GridLineIndex), COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(Cint(GridLineIndex), COLUMN_SCANNED))
Amount = Total - Scanned
If (Amount > 0) Then
MacroFlag = Cint(Grid.GetCellValue(Cint(GridLineIndex), COLUMN_MACRO_FLAG))
If (ChargeFlag = 0) Then
' Normale Artikel
ChooseableTokens = ChooseableTokens & " #" & GridLineIndex & "# "
InputPrompt = InputPrompt & "Zeile " & GridLineIndex & vbTab & " - Menge " & Amount
If MacroFlag = 2 Then
InputPrompt = InputPrompt & " (Package)"
End If
InputPrompt = InputPrompt & vbNewLine
Else
' SN-Artikel / Späte Ausprägungen
' Hier muss entschieden werden, ob ein Satz überhaupt angezeigt werden soll
MacroLineNumberToken = "#" & Grid.GetCellValue(Cint(GridLineIndex), COLUMN_MACRO_LINE_NUMBER) & "#"
If (InStr(AlreadyUsedAreasTokens, MacroLineNumberToken) = 0) Then
AlreadyUsedAreasTokens = AlreadyUsedAreasTokens & " " & MacroLineNumberToken
ChooseableTokens = ChooseableTokens & " #" & GridLineIndex & "# "
InputPrompt = InputPrompt & "Zeile " & GridLineIndex & vbTab & " - Menge " & Amount
If MacroFlag = 2 Then
InputPrompt = InputPrompt & " (Package)"
End If
InputPrompt = InputPrompt & vbNewLine
Else
Exit Do
End If
End If
End If
Loop While False: Next
InputPrompt = InputPrompt & vbNewLine & "Auf welche Zeile soll die gescannte Menge [" & ScannedAmount & "] gebucht werden?"
inputBoxValue = InputBox(InputPrompt, InputTitle, InputDefault)
Select Case True
Case IsEmpty(inputBoxValue)
' Abbruchbutton der InputBox geklickt
ShowDuplicateInputBox = NO_GRIDLINE_INDEX_CHOSEN
Case "" = Trim(inputBoxValue)
' Kein Wert eingegeben und OK geklickt
ShowDuplicateInputBox = NO_GRIDLINE_INDEX_CHOSEN
Case Else
' Wert eingegeben und OK geklickt
testToken = "#" & inputBoxValue & "#"
If (InStr(ChooseableTokens, testToken) > 0) Then
' Alles Rotscha in Kambodscha!
ShowDuplicateInputBox = inputBoxValue
Else
' Ungültiger Wert
ShowDuplicateInputBox = GRIDLINE_INDEX_IS_NOT_CHOOSEABLE
End If
End Select
End Function

61
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/GetArticleNumberFromSecondaryIndentifier.vbm Normal file
View File

@@ -0,0 +1,61 @@
' GetArticleNumberFromSecondaryIndentifier(Identifier : String)
' ----------------------------------------------------------------------------
' Gibt die Artikelnummer für Spät-Auspräge-Artikel zurück
'
' Returns: GetArticleNumberFromSecondaryIndentifier : String
' ----------------------------------------------------------------------------
' 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: 23.10.2020 / JJ
' Version Date / Editor: 15.12.2021 / MP
' Version Number: 4.0.0.0
Function GetArticleNumberFromSecondaryIndentifier(Identifier)
SQL = ""
' EAN-Code / Alternative Artikelnummer 1 / Alternative Artikelnummer 2 / Artikelnummer / S/N
SQL = SQL & "("
SQL = SQL & "(C002 = '" & Identifier & "') Or " ' Artikelnummer
SQL = SQL & "(C068 = '" & Identifier & "') Or " ' Charge-/Identnummer
SQL = SQL & "(C075 = '" & Identifier & "') Or " ' EAN-Code
SQL = SQL & "(C114 = '" & Identifier & "') Or " ' Alternative Artikelnummer 1
SQL = SQL & "(C115 = '" & Identifier & "')" ' Alternative Artikelnummer 2
SQL = SQL & ") "
' Nur Nach Hauptartikel/Ausprägungs(kind)artikel suchen
' SQL = SQL & "And C014 IN (0, 2)"
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set Result = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for SerialNumber-Regex by ArticleNumber " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "GetArticleNumberFromSecondaryIndentifier"
End If
If Result.RowCount > 0 Then
GetArticleNumberFromSecondaryIndentifier = Result.Value("c010")
Else
GetArticleNumberFromSecondaryIndentifier = ""
End If
End Function
' Optimierung
'SELECT TOP 1 t.c010
'FROM t023 t
' INNER JOIN t024 t2 ON t.mesoprim = t2.c143
'WHERE
' (t2.C002 = '819177021486' Or
' t2.C068 = '819177021486' Or
' t2.C075 = '819177021486' Or
' t2.C114 = '819177021486' Or
' t2.C115 = '819177021486') AND
' t2.mesoyear = 1452 AND
' t2.mesocomp = 'MEDP'

37
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/GetNextFreeArticleRow.vbm Normal file
View File

@@ -0,0 +1,37 @@
' GetNextFreeArticleRow(ArticleNumber : String)
' ----------------------------------------------------------------------------
' Gibt den Grid Index der nächsten freien Zeile für das Scan-Ergebnis zurück
'
' Returns: GetNextFreeArticleRow : Int
' ----------------------------------------------------------------------------
' 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: 30.09.2020 / JJ
' Version Date / Editor: 30.09.2020 / JJ
' Version Number: 4.0.0.0
Function GetNextFreeArticleRow(ArticleNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Dim NextFreeRow : NextFreeRow = -1
If DEBUG_ON = True Then
AddDebugLine "Getting next free row for Article: " & ArticleNumber
ShowDebugBox "GetNextFreeArticleRow"
End If
For GridIndex = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(GridIndex, COLUMN_ARTICLENUMBER)
CurrentSerialNumber = Grid.GetCellValue(GridIndex, COLUMN_SERIALNUMBER)
If UCase(ArticleNumber) = UCase(CurrentArticleNumber) And Len(CurrentSerialNumber) = 0 Then
NextFreeRow = GridIndex
Exit For
End If
Next
GetNextFreeArticleRow = NextFreeRow
End Function

68
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/IsOrderAvailable.vbm Normal file
View File

@@ -0,0 +1,68 @@
' IsOrderAvailable(OrderNumber : String)
' ----------------------------------------------------------------------------
' Überprüft, ob Auftrag noch (teilweise) offen ist
'
' Returns: OrderAvailable: Boolean
' ----------------------------------------------------------------------------
' 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: 01.09.2020 / JJ
' Version Date / Editor: 26.04.2021 / MP
' Version Number: 4.0.0.0
Function IsOrderAvailable(OrderNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Err.Clear
IsOrderAvailable = False
'Set SQL Table and Query for DocHead. Default: "T025"
'c023 - c026 = Druckstufen; c098 = Freigabeflag Angebot; c139 = Belegstufe;
'c035 = Belegart
'--> Query is not complete, will be build in the script later this time!
SQL = ""
SQL = SQL & "(c044 = '" & OrderNumber & "') "
SQL = SQL & "AND (c024 = '*' AND c025 != '*' AND c026 != '*') " ' Auftrag gedruckt, LS/Rech noch nicht gedruckt.
SQL = SQL & "AND (c025 IN ('M', 'A', 'S')) " ' Druckstatus Lieferschein
SQL = SQL & "AND (c115 < 900) " ' Flag Freigabekontrolle Auftrag
SQL = SQL & "AND (c139 = 2) " ' Belegstufe 2 = Auftrag
SQL = SQL & SQLQuery_OrderWhere
Set Result = CWLStart.CurrentCompany.SearchRecord(TABLE_25, SQL)
If DEBUG_ON = True Then
MsgBox "SQL: ... FROM " & TABLE_25 & " WHERE " & SQL, vbOkonly, DEBUG_TITLE
AddDebugLine "Checking For Order by OrderId.." & vbNewline & vbNewline
AddDebugLine "Result Columns: " & Result & vbNewline
AddDebugLine "Result Rows: " & Result.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "IsOrderAvailable"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei SQL-Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - IsOrderAvailable"
Exit Function
Else
Message = "Der Auftrag [" & OrderNumber & "] wurde nicht geladen aus einem der folgenden Gründe:" & vbNewLine & vbNewLine
Message = Message & "- Auftrag existiert nicht" & vbNewLine
Message = Message & "- Auftrag ist durch Fibu gesperrt" & vbNewLine
Message = Message & "- Auftrag wurde bereits erledigt" & vbNewLine
Message = Message & "- Beleg ist kein Auftrag"
MsgBox Message, vbExclamation, DEFAULT_TITLE
Exit Function
End If
End If
If Result.RowCount > 0 Then
IsOrderAvailable = True
End If
End Function

38
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/IsOrderComplete.vbm Normal file
View File

@@ -0,0 +1,38 @@
' IsOrderComplete()
' ----------------------------------------------------------------------------
' Überprüft, ob alle Zeilen vollständig gescannt wurden
'
' Returns: OrderComplete: Boolean
' ----------------------------------------------------------------------------
' 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: 25.09.2020 / JJ
' Version Date / Editor: 01.04.2020 / MP
' Version Number: 4.0.0.0
Function IsOrderComplete()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
IsOrderComplete = True
For GridIndex = 1 To Grid.LineCount: Do
Total = Cint(Grid.GetCellValue(GridIndex, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(GridIndex, COLUMN_SCANNED))
MacroFlag = Cint(Grid.GetCellValue(GridIndex, COLUMN_MACRO_FLAG))
If MacroFlag = 1 Then
' Continue weil Makro-Haupt-Artikel nicht geprüft werden
' Sonstige Artikel, wie z.B. Versandkosten, werden bereits als komplett ins Grid geladen
Exit Do
End If
If Scanned < Total Then
IsOrderComplete = False
Exit For
End If
Loop While False: Next
End Function

86
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/IsOrderLocked.vbm Normal file
View File

@@ -0,0 +1,86 @@
' IsOrderLocked(OrderNumber : Int)
' ----------------------------------------------------------------------------
' Gibt die UserID des Benutzers zurück, der den Auftrag sperrt.
' Wenn der Auftrag nicht gesperrt ist, wird 0 zurückgegeben.
'
' Returns: IsOrderLocked: Int
' ----------------------------------------------------------------------------
' 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: 26.04.2021 / MP
' Version Date / Editor: 26.04.2021 / MP
' Version Number: 4.0.0.0
' Hole die interne Belegnummer
' t025.c021 = Kontonummer und t025.c022 = Laufende Nummer
Function GetInternalOrderNumber(OrderNumber)
GetInternalOrderNumber = ""
Err.Clear
If Len(OrderNumber) > 0 Then
Set Conn = CWLStart.Connection
Dim SQL : SQL = ""
SQL = SQL & " SELECT TOP 1 c021, c022"
SQL = SQL & " FROM t025 (NOLOCK) "
SQL = SQL & " WHERE c044 = '"& OrderNumber & "'"
SQL = SQL & SQLQuery_OrderWhere
SQL = SQL & " ORDER BY c022"
Set Result = Conn.Select(SQL)
If Result < 0 Then
If err <> 0 Then
MsgBox "Fehler bei SQL-Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - GetInternalOrderNumber"
Exit Function
Else
Message = "Den Auftrag [" & OrderNumber & "] gibt es nicht in der Datenbank"
MsgBox Message, vbExclamation, DEFAULT_TITLE
Exit Function
End If
End If
GetInternalOrderNumber = result.Value("c021") & result.Value("c022")
End If
End Function
Function IsOrderLocked(OrderNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Err.Clear
IsOrderLocked = 0
InternalOrderNumber = GetInternalOrderNumber(OrderNumber)
SQL = ""
SQL = SQL & " c001 = 'E" & InternalOrderNumber & "' "
SQL = SQL & SQLQuery_BasicWhere
Set Result = CWLStart.CurrentCompany.SearchRecord(TABLE_499, SQL)
If DEBUG_ON = True Then
MsgBox "SQL: ... FROM " & TABLE_499 & " WHERE " & SQL, vbOkonly, DEBUG_TITLE
AddDebugLine "Checking For Order by internal OrderId [" & InternalOrderNumber & "]:"& vbNewline & vbNewline
AddDebugLine "Result Columns: " & Result & vbNewline
AddDebugLine "Result Rows: " & Result.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "IsOrderLocked"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - IsOrderLocked"
Exit Function
End If
End If
If Result.RowCount > 0 Then
IsOrderLocked = Result.Value("C002")
End If
End Function

478
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/LoadOrder.vbm Normal file
View File

@@ -0,0 +1,478 @@
' LoadOrder(OrderNumber : String)
' ----------------------------------------------------------------------------
' Sucht Belegzeilen zur angegebenen Belegnummer
' - Filtert Artikel der konf. Artikelgruppe (EXCLUDED_ARTICLEGROUPS) aus
' - Lädt Ergebnisse in eine Tabelle auf dem Formular
' - Erzeugt N Zeilen für Seriennummer-Artikel der Menge N
'
' Returns: LoadOrder : Boolean
' ----------------------------------------------------------------------------
' 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: 01.09.2020 / JJ
' Version Date / Editor: 22.03.2022 / MP
' Version Number: 4.0.0.0
Function GetSQL(OrderNumber)
Dim SQL : SQL = ""
SQL = SQL & " SELECT t2.*, t3.c037 c2137, t3.c079 c2179, t3." & ART_REGEX_FLDBEZ & " c21222"
SQL = SQL & " FROM t025 t (NOLOCK)"
SQL = SQL & " JOIN t026 t2 (NOLOCK) ON t.c021 = t2.c044 AND t.c022 = t2.c045"
SQL = SQL & " LEFT OUTER JOIN v021 t3 (NOLOCK) ON t2.c003 = t3.c002 AND t2.mesoyear = t3.mesoyear"
SQL = SQL & " WHERE t.c044 = '"& OrderNumber &"' AND t.c045 IS NULL"
SQL = SQL & " AND (t2.c099 = 0)"
'SQL = SQL & " AND (t2.c005 - t2.c016) > 0 AND (t2.c099 = 0)" --> wegen späten Ausprägungen brauchen wir alle Zeilen
' Nach Mandant und Wirtschaftsjahr filtern
OrderWhere = SQLQuery_OrderWhere
OrderWhere = Replace(OrderWhere, "mesocomp", "t2.mesocomp")
OrderWhere = Replace(OrderWhere, "mesoyear", "t2.mesoyear")
SQL = SQL & OrderWhere
' Nach Zeilennummer sortieren
SQL = SQL & " ORDER BY t2.c000"
GetSQL = SQL
End Function
Function GetMacroArticleCount(MacroName)
Dim CountResult : CountResult = 0
If Len(MacroName) > 0 Then
Set Conn = CWLStart.Connection
Dim SQL : SQL = ""
SQL = SQL & " SELECT count(*) c001"
SQL = SQL & " FROM t326 (NOLOCK) "
SQL = SQL & " WHERE c002 like '"& MacroName &"%'"
SQL = SQL & SQLQuery_BasicWhere
Set Result = Conn.Select(SQL)
CountResult = result.Value("c001")
End If
GetMacroArticleCount = CountResult
End Function
Function FillOrderArticleData(OrderNumber)
Set Conn = CWLStart.Connection
Err.Clear
SQL = GetSQL(OrderNumber)
Set Result = Conn.Select(SQL)
Set CountResult = Result
If DEBUG_ON = True Then
MsgBox "SQL:" & SQL, vbOkonly, DEBUG_TITLE
AddDebugLine "Searching For Order by OrderId (Mid Table).." & vbNewline & vbNewline
AddDebugLine "Result Columns: " & Result & vbNewline
AddDebugLine "Result Rows: " & Result.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "LoadOrder"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - LoadOrder"
Exit Function
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - LoadOrder"
Exit Function
End If
End If
' Belegung globaler Variablen für späteren Gebrauch
ORDER_ACCOUNT_NUMBER = Result.Value("c044")
ORDER_RUNNING_NUMBER = Result.Value("c045")
' Makro-Gruppenwechsel
Dim macroSubArticleCounter : macroSubArticleCounter = 0
Dim macroFlagForSNArticles : macroFlagForSNArticles = 0
Dim macroName : macroName = ""
Dim macroLineNumber : macroLineNumber = 0
Dim macroMaxLineNumber : macroMaxLineNumber = 0 ' Größte Zeilennummer eines Macros
Dim IsLateShape : IsLateShape = 0
OrderArrayIndex = 0
MacroArrayIndex = 0
' Doppelte Do Schleife, um ein "Continue While" zu ermöglichen
Do: Do
macroFlagForSNArticles = 0
AddTwoDimArrayRow ORDER_ARTICLE_DATA
ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex) = result.Value("c078")
ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex) = result.Value("c003")
ORDER_ARTICLE_DATA(INDEX_MAIN_ARTICLE_NUMBER, OrderArrayIndex) = result.Value("c011")
ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex) = result.Value("c012")
ORDER_ARTICLE_DATA(INDEX_DATA_TYPE, OrderArrayIndex) = result.Value("c042")
ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex) = result.Value("c2137")
ORDER_ARTICLE_DATA(INDEX_ARTICLE_TYPE, OrderArrayIndex) = result.Value("c2179")
ORDER_ARTICLE_DATA(INDEX_DESCRIPTION, OrderArrayIndex) = result.Value("c004")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) = result.Value("c005")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex) = result.Value("c016")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_REMAINING, OrderArrayIndex) = result.Value("c099")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_SERIAL_NUMBER, OrderArrayIndex) = ""
ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex) = result.Value("c055")
ORDER_ARTICLE_DATA(INDEX_IS_SERIAL_NUMBER, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_ARTICLE_REGEX, OrderArrayIndex) = result.Value("c21222")
ORDER_ARTICLE_DATA(INDEX_IS_LATE_SHAPE, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = False
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_MACRO_LINE_NUMBER, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_PRICE_VK_EINZEL, OrderArrayIndex) = result.Value("c007")
ORDER_ARTICLE_DATA(INDEX_IS_OPEN, OrderArrayIndex) = False
' Alle Belegzeilen, die schon geliefert wurden, werden von der Restlichen Logik nicht berührt
If (ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) - ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex)) <= 0 Then
' Vorzeitiger Abbruch, trotzdem den Zähler erhöhen
OrderArrayIndex = OrderArrayIndex + 1
Exit Do
Else
ORDER_ARTICLE_DATA(INDEX_IS_OPEN, OrderArrayIndex) = True
End If
If (Len(ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex)) > 0) Then
' Hier haben wir den Makro-Hauptartikel gefunden
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex) = 1
AddTwoDimArrayRow MACRO_ARTICLE_LIST
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_LINE_NUMBER, MacroArrayIndex) = ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex)
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_NUMBER, MacroArrayIndex) = ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex)
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_DESCRIPTION, MacroArrayIndex) = ORDER_ARTICLE_DATA(INDEX_DESCRIPTION, OrderArrayIndex)
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_REMAINING, MacroArrayIndex) = ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) - ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex)
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED, MacroArrayIndex) = 0
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_COMPLETE, MacroArrayIndex) = True 'Wird umgesetzt, falls unvollständig
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_GRID_LINE_INDEX, MacroArrayIndex) = 0
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_SCAN_FLAG, MacroArrayIndex) = False
MacroArrayIndex = MacroArrayIndex + 1
macroLineNumber = ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex)
macroName = ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex)
macroSubArticleCounter = GetMacroArticleCount(ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex)) ' Problematisch bei Teillieferungen
macroMaxLineNumber = macroLineNumber + macroSubArticleCounter
End If
If (ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex) = 0 And _
macroSubArticleCounter > 0 And _
ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex) <= macroMaxLineNumber) Then
' Dies muss ein Sub-Makro-Hauptartikel sein
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex) = 2
' Makro Name für Sub-Makro-Artikel speichern
ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex) = macroName
' Makro Zeilennummer für Sub-Makro-Artikel speichern
ORDER_ARTICLE_DATA(INDEX_MACRO_LINE_NUMBER, OrderArrayIndex) = macroLineNumber
' Nachfolgende S/N Artikel bekommen das gleiche Flag
macroFlagForSNArticles = ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex)
macroSubArticleCounter = macroSubArticleCounter - 1
ElseIf (macroSubArticleCounter = 0 OR _
ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex) > macroMaxLineNumber) Then
macroLineNumber = 0
macroMaxLineNumber = 0
End if
If CheckArticleGroupIsRelevant(ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex)) = False Then
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) - ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex)
End If
' Alle Nicht-Artikel (z.B Texte) immer mit Menge 0
If ORDER_ARTICLE_DATA(INDEX_DATA_TYPE, OrderArrayIndex) <> 1 Then
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) = 0
End If
' Sichtbar Ja / Nein?
If (ORDER_ARTICLE_DATA(INDEX_DATA_TYPE, OrderArrayIndex) = 1 And _
ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex) <> 12 And _
CheckArticleGroupIsRelevant(ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex)) = True) Then
ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = True
End If
' Wenn Option Alle Artikel Sichtbar aktiv ist
If (OPTION_ALL_ARTICLES > 0 And _
ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = False) Then
ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = True
End If
If (ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex) = 2) Then
ORDER_ARTICLE_DATA(INDEX_IS_SERIAL_NUMBER, OrderArrayIndex) = 1
End If
If (Len(ORDER_ARTICLE_DATA(INDEX_ARTICLE_REGEX, OrderArrayIndex)) > 0) Then
ORDER_ARTICLE_DATA(INDEX_IS_LATE_SHAPE, OrderArrayIndex) = 1
IsLateShape = 1
Else
ORDER_ARTICLE_DATA(INDEX_IS_LATE_SHAPE, OrderArrayIndex) = 0
IsLateShape = 0
End If
If (Len(Result.Value("c067")) > 0) Then
' Belegung hier, weil Text-Artikel keine Belegnummer enthalten
ORDER_DOCUMENT_NUMBER = Result.Value("c067")
End If
' Duplikate scanbarer Artikel ermitteln
If (ORDER_ARTICLE_DATA(INDEX_DATA_TYPE, OrderArrayIndex) = 1 And _
ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex) <> 12 And _
CheckArticleGroupIsRelevant(ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex)) = True And _
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex) <> 1) Then
AddArticleNumberToDuplList ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex), _
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex), _
ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex)
End If
Dim AmountOrdered, AmountDelivered, ChargeFlag
ChargeFlag = CInt(result.Value("c055"))
AmountOrdered = CInt(result.Value("c005"))
AmountDelivered = CInt(result.Value("c016"))
Amount = AmountOrdered - AmountDelivered
If ChargeFlag = 2 Then
'Dim PseudoArray()
' Pseudonummern reservieren, wenn der Artikel ein Spätauspräger ist
If IsLateShape = 1 Then
PseudoArray = AllocatePseudoSerialNumbers(OrderNumber, result.Value("c003"), Amount)
If Len(PseudoArray(0)) <= 0 Then
Msgbox "Auftrag kann nicht bearbeitet werden!", vbExclamation, DEFAULT_TITLE & " - LoadOrder"
Exit Function
End If
' Erste Zeile für SN Artikel mit erster Pseudo SN füllen
ORDER_ARTICLE_DATA(INDEX_PSEUDO_SN, OrderArrayIndex) = PseudoArray(0)
End If
' Amount wird um 1 reduziert, da für den Artikel bereits
' eine Zeile aus der Schleife oben existiert
For Index = 1 To Amount - 1
AddTwoDimArrayRow ORDER_ARTICLE_DATA
OrderArrayIndex = OrderArrayIndex + 1
ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex) = result.Value("c078")
ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex) = result.Value("c003")
ORDER_ARTICLE_DATA(INDEX_MAIN_ARTICLE_NUMBER, OrderArrayIndex) = result.Value("c011")
ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex) = result.Value("c012")
ORDER_ARTICLE_DATA(INDEX_DATA_TYPE, OrderArrayIndex) = result.Value("c042")
ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex) = macroName
ORDER_ARTICLE_DATA(INDEX_ARTICLE_TYPE, OrderArrayIndex) = result.Value("c2179")
ORDER_ARTICLE_DATA(INDEX_DESCRIPTION, OrderArrayIndex) = result.Value("c004")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) = result.Value("c005")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex) = result.Value("c016")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_REMAINING, OrderArrayIndex) = result.Value("c099")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_SERIAL_NUMBER, OrderArrayIndex) = ""
ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex) = result.Value("c055")
ORDER_ARTICLE_DATA(INDEX_IS_SERIAL_NUMBER, OrderArrayIndex) = 1
ORDER_ARTICLE_DATA(INDEX_ARTICLE_REGEX, OrderArrayIndex) = result.Value("c21222")
ORDER_ARTICLE_DATA(INDEX_IS_LATE_SHAPE, OrderArrayIndex) = IsLateShape
ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = True
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex) = macroFlagForSNArticles
ORDER_ARTICLE_DATA(INDEX_MACRO_LINE_NUMBER, OrderArrayIndex) = macroLineNumber
ORDER_ARTICLE_DATA(INDEX_PRICE_VK_EINZEL, OrderArrayIndex) = result.Value("c007")
ORDER_ARTICLE_DATA(INDEX_IS_OPEN, OrderArrayIndex) = True
If IsLateShape = 1 Then
ORDER_ARTICLE_DATA(INDEX_PSEUDO_SN, OrderArrayIndex) = PseudoArray(Index)
End If
' Wir benötigen die korrekte Anzahl der Zeilen eines Artikels
AddArticleNumberToDuplList ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex), _
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex), _
ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex)
Next
End If
OrderArrayIndex = OrderArrayIndex + 1
' Doppelte Do Schleife, um ein "Continue While" zu ermöglichen
Loop While False: Loop While Result.NextRecord = True
' Enthält die Anzahl der Macro-Hauptartikel
MACRO_ARTICLE_COUNTER = MacroArrayIndex
FillOrderArticleData = OrderArrayIndex
End Function
Function LoadOrder(OrderNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
ASK_FOR_DELNOTE = False
If (FillOrderArticleData(OrderNumber) <= 0) Then
LoadOrder = False
Exit Function
ElseIf (ExistVisibleRows() = False) Then
' Es gibt keine sichtbaren Zeilen, d.h. es gibt auch nix zu scannen.
' Da aber ein Lieferschein erzeugt werden kann, zeigen wir jetzt alles an,
' und fragen nach dem Laden ob der letzte LS direkt erstellt werden soll
ShowAllArticles()
ASK_FOR_DELNOTE = True
End If
Grid.InitUserGrid
Grid.Header
Grid.Clear(1002)
Grid.IsRedraw = False
' Zähler für Grid
' Wird immer hoch gezählt bei Grid.AddLine
GridLineCounter = 1
' Zähler für Datenstruktur
' Wird in JEDEM Durchlauf hochgezählt
OrderArrayIndex = 0
Do
' Speicher für benutzerdefinierte Felder im Grid
' (495,0) - Menge Gesamt
' (495,1) - Menge Gescannt
' (495,2) - Seriennummer
' (495,3) - Artikelnummer
' (495,4) - Bezeichnung
' (495,5) - Seriennummer Ja/Nein
' (495,6) - Spät Ausprägung Ja/Nein
' (495,7) - Interne Zeilennumemr
Dim AmountOrdered, AmountDelivered
AmountOrdered = Cint(ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex))
AmountDelivered = Cint(ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex))
ProductGroup = Cint(ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex))
Amount = AmountOrdered - AmountDelivered
SalesMacro = ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex)
ArticleType = ORDER_ARTICLE_DATA(INDEX_ARTICLE_TYPE, OrderArrayIndex)
ChargeFlag = Cint(ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex))
IsLateShape = Cint(ORDER_ARTICLE_DATA(INDEX_IS_LATE_SHAPE, OrderArrayIndex))
ArticleNumber = ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex)
Description = ORDER_ARTICLE_DATA(INDEX_DESCRIPTION, OrderArrayIndex)
IsVisible = ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex)
LineNumber = CInt(ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex))
IsSerialNumber = CInt(ORDER_ARTICLE_DATA(INDEX_IS_SERIAL_NUMBER, OrderArrayIndex))
MacroFlag = CInt(ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex))
MacroLineNumber = CInt(ORDER_ARTICLE_DATA(INDEX_MACRO_LINE_NUMBER, OrderArrayIndex))
If (IsVisible = True) Then
If ChargeFlag = 2 Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = 1
CWLCurrentWindow.ActiveWindow.Vars.Value(495,1) = 0
ResetableFlag = 1
If MacroFlag = 2 Then
LineColor = COLOR_PACKAGE_RED
AddMacroLineNumberTokensToDuplicateArticles ArticleNumber, MacroLineNumber
Else
LineColor = COLOR_RED
End If
' GridLine Index der Duplikate-Struktur hinzufügen
AddGridLineIndexToDuplicateArticles ArticleNumber, GridLineCounter
ElseIf (CheckArticleGroupIsRelevant(ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex)) = False) OR AmountOrdered = 0 Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = Amount
CWLCurrentWindow.ActiveWindow.Vars.Value(495,1) = Amount
ResetableFlag = 0
If MacroFlag = 2 Then
LineColor = COLOR_PACKAGE_GREEN
Else
LineColor = COLOR_GREEN
End If
ElseIf MacroFlag = 1 Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = Amount
CWLCurrentWindow.ActiveWindow.Vars.Value(495,1) = 0
ResetableFlag = 0
LineColor = COLOR_BLUE
Else
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = Amount
CWLCurrentWindow.ActiveWindow.Vars.Value(495,1) = 0
ResetableFlag = 1
If MacroFlag = 2 Then
LineColor = COLOR_PACKAGE_RED
AddMacroLineNumberTokensToDuplicateArticles ArticleNumber, MacroLineNumber
Else
LineColor = COLOR_RED
End If
' GridLine Index der Duplikate-Struktur hinzufügen
AddGridLineIndexToDuplicateArticles ArticleNumber, GridLineCounter
End If
CWLCurrentWindow.ActiveWindow.Vars.Value(495,2) = ""
CWLCurrentWindow.ActiveWindow.Vars.Value(495,3) = ArticleNumber
CWLCurrentWindow.ActiveWindow.Vars.Value(495,4) = Description
CWLCurrentWindow.ActiveWindow.Vars.Value(495,5) = IsSerialNumber
CWLCurrentWindow.ActiveWindow.Vars.Value(495,6) = IsLateShape
CWLCurrentWindow.ActiveWindow.Vars.Value(495,7) = LineNumber
CWLCurrentWindow.ActiveWindow.Vars.Value(495,8) = GridLineCounter
CWLCurrentWindow.ActiveWindow.Vars.Value(495,9) = ResetableFlag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,10) = MacroFlag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,11) = MacroLineNumber
' Neue Grid-Zeile schreiben
Grid.AddLine
' Zeilenfarbe mit ROT vorbelegen
Grid.SetLineColor GridLineCounter, LineColor
GridLineCounter = GridLineCounter + 1
End If
OrderArrayIndex = OrderArrayIndex + 1
Loop While OrderArrayIndex < (UBound(ORDER_ARTICLE_DATA, 2) + 1)
LoadOrder = True
Grid.IsRedraw = True
End Function
' Schaltet alle nicht sichtbaren Felder auf sichtbar um
Sub ShowAllArticles
For OrderArrayIndex = 0 to UBound(ORDER_ARTICLE_DATA, 2)
If (ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = False And ORDER_ARTICLE_DATA(INDEX_IS_OPEN, OrderArrayIndex) = True) Then
ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = True
End If
Next
End Sub
' Gibt True zurück, wenn es min. 1 sichtbare Zeile gibt
Function ExistVisibleRows
ExistVisibleRows = False
For OrderArrayIndex = 0 to UBound(ORDER_ARTICLE_DATA, 2)
If (ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = True) Then
ExistVisibleRows = True
Exit For
End If
Next
End Function

210
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/PacktischHistorySQL.vbm Normal file
View File

@@ -0,0 +1,210 @@
' PacktischHistorySQL()
' ----------------------------------------------------------------------------
' Stellt Methoden für den Zugriff auf die Tabelle Packtisch bereit
'
' 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: 15.02.2022 / MP
' Version Date / Editor: 01.06.2023 / MP/JJ
' Version Number: 4.1.0.0
Sub InsertPacktischHistoryRow(AuftragsNr, ArtikelNr, PseudoSN)
Set Conn = CWLStart.Connection
Err.Clear
Dim NowObject : NowObject = Now
Dim DateString : DateString = Year(NowObject) & "-" & GetLeftPad(Month(NowObject)) & "-" & GetLeftPad(Day(NowObject))
Dim TimeString : TimeString = GetLeftPad(Hour(NowObject)) & ":" & GetLeftPad(Minute(NowObject)) & ":" & GetLeftPad(Second(NowObject))
Dim RechnerName : RechnerName = GetWindowsEnvironment("COMPUTERNAME")
Dim InsertSQL : InsertSQL = ""
InsertSQL = InsertSQL & "INSERT INTO dbo.TBDD_PACKTISCH_HISTORY "
InsertSQL = InsertSQL & " ([AuftragsNr] "
InsertSQL = InsertSQL & " ,[ArtikelNr] "
InsertSQL = InsertSQL & " ,[PseudoSN] "
InsertSQL = InsertSQL & " ,[Rechnername] "
InsertSQL = InsertSQL & " ,[ErstelltWann] "
InsertSQL = InsertSQL & " ,[PacktischVersion] "
InsertSQL = InsertSQL & " ,[mesocomp] "
InsertSQL = InsertSQL & " ,[mesoyear] "
InsertSQL = InsertSQL & " ,[Status] "
InsertSQL = InsertSQL & " ) VALUES ( "
InsertSQL = InsertSQL & "'" & AuftragsNr & "', "
InsertSQL = InsertSQL & "'" & ArtikelNr & "', "
InsertSQL = InsertSQL & "'" & PseudoSN & "', "
InsertSQL = InsertSQL & "'" & RechnerName & "', "
InsertSQL = InsertSQL & "'" & DateString & " " & TimeString & "', "
InsertSQL = InsertSQL & "'" & PACKTISCH_VERSION & "', "
InsertSQL = InsertSQL & "'" & MandatorNr & "', "
InsertSQL = InsertSQL & "'" & WinlineCurrentYear & "', "
InsertSQL = InsertSQL & "'Locked'"
InsertSQL = InsertSQL & " ) "
Result = Conn.ExecuteSQL(InsertSQL)
If DEBUG_ON = True Then
AddDebugLine "TBDD_PACKTISCH_HISTORY - Insert"
AddDebugLine "SQL: " & InsertSQL
ShowDebugBox "InsertPacktischHistoryRow"
End If
If Result = False Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - InsertPacktischHistoryRow"
Exit Sub
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - InsertPacktischHistoryRow"
Exit Sub
End If
End If
End Sub
Sub UpdatePacktischHistoryRow(AuftragsNr, ArtikelNr, PseudoSN, Status, RealSN)
Set Conn = CWLStart.Connection
Err.Clear
Dim NowObject : NowObject = Now
Dim DateString : DateString = Year(NowObject) & "-" & GetLeftPad(Month(NowObject)) & "-" & GetLeftPad(Day(NowObject))
Dim TimeString : TimeString = GetLeftPad(Hour(NowObject)) & ":" & GetLeftPad(Minute(NowObject)) & ":" & GetLeftPad(Second(NowObject))
Dim RechnerName : RechnerName = GetWindowsEnvironment("COMPUTERNAME")
Dim UpdateSQL : UpdateSQL = ""
UpdateSQL = UpdateSQL & "UPDATE dbo.TBDD_PACKTISCH_HISTORY "
UpdateSQL = UpdateSQL & "SET [Status] = '" & Status & "', "
UpdateSQL = UpdateSQL & "[GeaendertWann] = '" & DateString & " " & TimeString & "' "
If Len(RealSN) > 0 Then
UpdateSQL = UpdateSQL & ", RealSN = '" & RealSN & "' "
End If
UpdateSQL = UpdateSQL & "WHERE AuftragsNr = '" & AuftragsNr & "' AND "
UpdateSQL = UpdateSQL & "ArtikelNr = '" & ArtikelNr & "' AND "
UpdateSQL = UpdateSQL & "PseudoSN = '" & PseudoSN & "' AND "
UpdateSQL = UpdateSQL & "Rechnername = '" & RechnerName & "'"
If DEBUG_ON = True Then
AddDebugLine "TBDD_PACKTISCH_HISTORY - Update"
AddDebugLine "SQL: " & UpdateSQL
ShowDebugBox "UpdatePacktischHistoryRow"
End If
Result = Conn.ExecuteSQL(UpdateSQL)
If Result = False Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - UpdatePacktischHistoryRow"
Exit Sub
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - UpdatePacktischHistoryRow"
Exit Sub
End If
End If
End Sub
Sub UpdatePacktischHistoryRowsAfterSuccess(AuftragsNr)
Set Conn = CWLStart.Connection
Err.Clear
Dim NowObject : NowObject = Now
Dim DateString : DateString = Year(NowObject) & "-" & GetLeftPad(Month(NowObject)) & "-" & GetLeftPad(Day(NowObject))
Dim TimeString : TimeString = GetLeftPad(Hour(NowObject)) & ":" & GetLeftPad(Minute(NowObject)) & ":" & GetLeftPad(Second(NowObject))
Dim RechnerName : RechnerName = GetWindowsEnvironment("COMPUTERNAME")
Dim UpdateSQL : UpdateSQL = ""
UpdateSQL = UpdateSQL & "UPDATE dbo.TBDD_PACKTISCH_HISTORY "
UpdateSQL = UpdateSQL & "SET [Status] = 'Used', "
UpdateSQL = UpdateSQL & "[GeaendertWann] = '" & DateString & " " & TimeString & "' "
UpdateSQL = UpdateSQL & "WHERE AuftragsNr = '" & AuftragsNr & "' AND "
UpdateSQL = UpdateSQL & "Rechnername = '" & RechnerName & "' AND "
UpdateSQL = UpdateSQL & "RealSN IS NOT NULL"
If DEBUG_ON = True Then
AddDebugLine "TBDD_PACKTISCH_HISTORY - Update"
AddDebugLine "SQL: " & UpdateSQL
ShowDebugBox "UpdatePacktischHistoryRowsAfterSuccess"
End If
Result = Conn.ExecuteSQL(UpdateSQL)
If Result = False Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - UpdatePacktischHistoryRowsAfterSuccess"
Exit Sub
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - UpdatePacktischHistoryRowsAfterSuccess"
Exit Sub
End If
End If
End Sub
Sub DeletePacktischHistoryRows()
Set Conn = CWLStart.Connection
Err.Clear
Dim RechnerName : RechnerName = GetWindowsEnvironment("COMPUTERNAME")
Dim DeleteSQL : DeleteSQL = ""
DeleteSQL = DeleteSQL & "DELETE FROM dbo.TBDD_PACKTISCH_HISTORY WHERE Rechnername = '" & Rechnername & "' "
DeleteSQL = DeleteSQL & "AND Status <> 'Used'"
If DEBUG_ON = True Then
AddDebugLine "TBDD_PACKTISCH_HISTORY - Delete"
AddDebugLine "SQL: " & UpdateSQL
ShowDebugBox "DeletePacktischHistoryRows"
End If
Result = Conn.ExecuteSQL(DeleteSQL)
If Result = False Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - DeletePacktischHistoryRows"
Exit Sub
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - DeletePacktischHistoryRows"
Exit Sub
End If
End If
End Sub

102
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/ReplacePseudoSerialNumbers.vbm Normal file
View File

@@ -0,0 +1,102 @@
' 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

78
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/ReplacePseudoSerialNumbers.vbm.bck Normal file
View File

@@ -0,0 +1,78 @@
' ReplacePseudoSerialNumbers()
' ----------------------------------------------------------------------------
' Stellt Methoden für den Zugriff auf die Tabelle Packtisch bereit
'
' 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: 23.03.2022 / MP
' Version Number: 4.0.0.0
Sub ReplacePseudoSerialNumbers(AuftragsNr, ArtikelNr, PseudoSN, RealSN)
Set Conn = CWLStart.Connection
Err.Clear
If Len(RealSN) = 0 Or Len(PseudoSN) = 0 Then
If DEBUG_ON = True Then
AddDebugLine "Fehlender SN Parameter :"
AddDebugLine "For Article " & ArtikelNr
AddDebugLine "RealSN: '" & RealSN & "'"
AddDebugLine "PseudoSN: '" & PseudoSN & "'"
ShowDebugBox "ReplacePseudoSerialNumbers"
End If
Exit Sub
End If
Dim ReplaceSQL : ReplaceSQL = ""
ReplaceSQL = ReplaceSQL & "update t024 set c068 = '" & RealSN & "' where c068 = '" & PseudoSN & "' "
ReplaceSQL = ReplaceSQL & SQLQuery_BasicWhere
If DEBUG_ON = True Then
AddDebugLine "Update t024.c068"
AddDebugLine "SQL: " & ReplaceSQL
ShowDebugBox "ReplacePseudoSerialNumbers"
End If
Result = Conn.ExecuteSQL(ReplaceSQL)
If Result = False Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - ReplacePseudoSerialNumbers"
Exit Sub
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - ReplacePseudoSerialNumbers"
Exit Sub
End If
End If
UpdatePacktischHistoryRow AuftragsNr, ArtikelNr, PseudoSN, "Scanned", RealSN
End Sub

112
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/ResetValuesByLineIndex.vbm Normal file
View File

@@ -0,0 +1,112 @@
' ResetValuesByLineIndex(LineIndex : INT)
' ----------------------------------------------------------------------------
' Setzt die Werte in einer bestimmten Zeile auf ihre
' Ausgangswerte zurück.
'
' 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: 15.03.2021 / MP
' Version Date / Editor: 15.03.2021 / MP
' Version Number: 4.0.0.0
Sub ResetValues(GridLineIndexToReset)
Set myWin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = myWin.Controls.Item(GRID_ID).Grid
For GridIndex = 1 To Grid.LineCount
If GridIndex = GridLineIndexToReset Then
Grid.SetCellValue GridIndex, COLUMN_SCANNED, 0
Grid.SetCellValue GridIndex, COLUMN_SERIALNUMBER, ""
If (Grid.GetCellValue(GridIndex, COLUMN_MACRO_FLAG) = 2) Then
Grid.SetLineColor GridIndex, COLOR_PACKAGE_RED
Else
Grid.SetLineColor GridIndex, COLOR_RED
End If
Exit For
End If
Next
End Sub
Sub ResetValuesByMacroLineNumber(MacroArticleLineNumber)
Set myWin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = myWin.Controls.Item(GRID_ID).Grid
For GridIndex = 1 To Grid.LineCount
MacroLineNumber = Cint(Grid.GetCellValue(GridIndex, COLUMN_MACRO_LINE_NUMBER))
If MacroLineNumber = MacroArticleLineNumber Then
Grid.SetCellValue GridIndex, COLUMN_SCANNED, 0
Grid.SetCellValue GridIndex, COLUMN_SERIALNUMBER, ""
Grid.SetLineColor GridIndex, COLOR_PACKAGE_RED
End If
Next
End Sub
Sub ResetValuesByLineIndex(LineIndex)
Set myWin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = myWin.Controls.Item(GRID_ID).Grid
If (Grid.LineCount <= 0) Then
MsgBox "Bitte scannen Sie zuerst eine Auftragsnummer!", vbOKOnly + vbInformation, DEFAULT_TITLE
Exit Sub
End If
Dim LineIndexToReset : LineIndexToReset = 0
If (LineIndex = -1) Then
InputBoxHeaderText = "Zeile zurücksetzen"
If (Grid.LineCount = 1) Then
InputBoxText = "Zeilennummer:"
InputBoxDefault = "1"
Else
InputBoxText = "Zeilennummer (Zeile [1 - " & Grid.LineCount & "]):"
InputBoxDefault = "0"
End If
LineIndexInputBox = InputBox(InputBoxText, InputBoxHeaderText, InputBoxDefault)
Select Case True
Case IsEmpty(LineIndexInputBox)
' Abbruch der Box
Exit Sub
Case "" = Trim(LineIndexInputBox)
' Kein Wert eingegeben = Abbruch
Exit Sub
Case Else
' Wert eingegeben und OK geklickt
If Len(LineIndexInputBox) > 0 Then
LineIndexToReset = Cint(LineIndexInputBox)
Else
LineIndexToReset = 0
End If
End Select
Else
LineIndexToReset = LineIndex
End If
If (LineIndexToReset <= 0 OR LineIndexToReset > Grid.LineCount) Then
MsgBox "Keine gültige Zeile ausgewählt!", vbOKOnly + vbInformation, DEFAULT_TITLE
ElseIf (Grid.GetCellValue(LineIndexToReset, COLUMN_RESETABLE_FLAG) = 0) Then
MsgBox "Die Zeile [" & LineIndexToReset & "] ist nicht änderbar!", vbOKOnly + vbInformation, DEFAULT_TITLE
ElseIf (LineIndexToReset > 0 And LineIndexToReset <= Grid.LineCount) Then
Answer = MsgBox("Sollen die Werte in Zeile [" & LineIndexToReset & "] zurückgesetzt werden?", vbYesno + vbQuestion, DEFAULT_TITLE)
If Answer = vbYes Then
ResetValues LineIndexToReset
CURRENT_GRID_LINE_INDEX = 0
End If
Else
MsgBox "Diese Zeilennummer gibt es nicht!"
End If
End Sub

30
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/SerialNumberExists.vbm Normal file
View File

@@ -0,0 +1,30 @@
' SerialNumberExists(SerialNumber : String)
' ----------------------------------------------------------------------------
' Prüft, ob die übergebene Seriennummer bereits gescannt wurde
'
' Returns: SerialNumberExists : Boolean
' ----------------------------------------------------------------------------
' 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: 25.09.2020 / JJ
' Version Date / Editor: 25.09.2020 / JJ
' Version Number: 4.0.0.0
Function SerialNumberExists(SerialNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
SerialNumberExists = False
For GridIndex = 1 To Grid.LineCount
CurrentSerialNumber = Grid.GetCellValue(GridIndex, COLUMN_SERIALNUMBER)
If SerialNumber = CurrentSerialNumber Then
SerialNumberExists = True
Exit For
End If
Next
End Function

27
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/SetAmount.vbm Normal file
View File

@@ -0,0 +1,27 @@
' SetAmount(Amount: Integer)
' ----------------------------------------------------------------------------
' Setzt eingegebene Menge in das Mengenfeld ein
' - Überschreibt Menge beim ersten Eintrag, danach
' wird die Zahl angehängt
'
' 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: 25.09.2020 / JJ
' Version Date / Editor: 25.09.2020 / JJ
' Version Number: 4.0.0.0
Sub SetAmount(Amount)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
If amountBox.Contents = AMOUNT_PLACEHOLDER Then
amountBox.Contents = Cstr(Amount)
Else
amountBox.Contents = amountBox.Contents & Cstr(Amount)
End If
End Sub

32
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/SetDebugMode.vbm Normal file
View File

@@ -0,0 +1,32 @@
' SetDebugMode()
' ----------------------------------------------------------------------------
' Zeigt je nach DEBUG-Mode die nicht sichtbaren Spalten
' im Grid an oder nicht, je nach DEBUG_ON-Einstellung.
'
' 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: 01.04.2021 / MP
' Version Date / Editor: 01.04.2021 / MP
' Version Number: 4.0.0.0
Sub SetDebugMode()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
' Unsichtbare Spalten anzeigen im DEBUG-Modus
Dim invisibleColWidth : invisibleColWidth = 0
If DEBUG_ON = True Then
invisibleColWidth = 5
End If
Grid.SetColumnWidth COLUMN_LINE_NUMBER, invisibleColWidth
Grid.SetColumnWidth COLUMN_RESETABLE_FLAG, invisibleColWidth
Grid.SetColumnWidth COLUMN_MACRO_FLAG, invisibleColWidth
Grid.SetColumnWidth COLUMN_MACRO_LINE_NUMBER, invisibleColWidth
End Sub

18
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/SetupProgram.vbm Normal file
View File

@@ -0,0 +1,18 @@
' SetupProgram()
' ----------------------------------------------------------------------------
' Initialisiert das Programm für den ersten Aufruf
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2022 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: 16.02.2022 / JJ/MP
' Version Date / Editor: 16.02.2022 / JP/MP
' Version Number: 4.0.0.0
Sub SetupProgram()
DeletePacktischHistoryRows()
End Sub

87
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/SetupWindow.vbm Normal file
View File

@@ -0,0 +1,87 @@
' SetupWindow()
' ----------------------------------------------------------------------------
' Definiert die Spalten des Grids und initialisiert Felder
'
' 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: 01.09.2020 / JJ
' Version Date / Editor: 30.03.2021 / MP
' Version Number: 4.0.0.0
Sub SetupWindow()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
' Speicher für benutzerdefinierte Felder
' (495,0) - Menge Gesamt
' (495,1) - Menge Gescannt
' (495,2) - Seriennummer
' (495,3) - Artikelnummer
' (495,4) - Bezeichnung
' (495,5) - Chargen-/Identflag
' (495,6) - Spät ausgeprägt bzw. Regex vorhanden
' (495,7) - Interne Zeilennummer aus Auftrag
' (495,8) - Sichtbare Zeilennummer im Grid
' (495,9) - Zeile darf resettet werden (J/N)
' (495,10) - Makro Flag (0 - Default / 1 = Macro-Artikel / 2 = Sub-Macro-Artikel)
' (495,11) - Makro Index, Zeilennummer des übergeordneten Makro-Artikels
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 0, "2", 10
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 1, "2", 10
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 2, "1", 20
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 3, "1", 20
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 4, "1", 60
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 5, "2", 3
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 6, "2", 3
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 7, "2", 3
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 8, "2", 4
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 9, "2", 3
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 10, "2", 3
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 11, "2", 3
Grid.InitUserGrid
Grid.IsRedraw = False
Grid.Header
If COLUMNS_CREATED = False Then
COLUMN_GRID_LINE_INDEX = Grid.AddColumn("#", "T22,Zeilenindex", "z", "V", 0, 495, 8, 4, sizeflag+hideflag)
COLUMN_ARTICLENUMBER = Grid.AddColumn("Artikelnummer", "T21,Artikelnummer", "l", "V", 0, 495, 3, 15, sizeflag+hideflag)
COLUMN_DESCRIPTION = Grid.AddColumn("Bezeichnung", "T21,Bezeichnung", "l", "V", 0, 495, 4, 37, sizeflag+hideflag)
COLUMN_TOTAL = Grid.AddColumn("Gesamt", "T22,Gesamt", "z", "V", 0, 495, 0, 10, sizeflag+hideflag)
COLUMN_SCANNED = Grid.AddColumn("Gescannt", "T22,Gescannt", "z", "V", 0, 495, 1, 10, sizeflag+hideflag)
COLUMN_SERIALNUMBER = Grid.AddColumn("Seriennummer", "T21,Seriennummer", "l", "V", 0, 495, 2, 20, sizeflag+hideflag)
COLUMN_CHARGE_FLAG = Grid.AddColumn("S/N?", "T17,Seriennummer", "l", "V", 0, 495, 5, 6, sizeflag+hideflag)
COLUMN_LATE_SHAPE = Grid.AddColumn("Auspr?", "T17,Spaetausgepr.", "l", "V", 0, 495, 6, 6, sizeflag+hideflag)
COLUMN_LINE_NUMBER = Grid.AddColumn("LN", "T22,Zeilennummer", "r", "V", 0, 495, 7, 0, 0) ' nicht sichtbar
COLUMN_RESETABLE_FLAG = Grid.AddColumn("RF", "T22,ResetableFlag", "r", "V", 0, 495, 9, 0, 0) ' nicht sichtbar
COLUMN_MACRO_FLAG = Grid.AddColumn("MF", "T22,MacroFlag", "r", "V", 0, 495, 10, 0, 0) ' nicht sichtbar
COLUMN_MACRO_LINE_NUMBER = Grid.AddColumn("MLN", "T22,MacroZeilenr", "r", "V", 0, 495, 11, 0, 0) ' nicht sichtbar
COLUMNS_CREATED = True
End If
Grid.IsRedraw = True
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
amountBox.Contents = AMOUNT_PLACEHOLDER
Set articleBox = mywin.Controls.Item(ARTICLE_INPUT)
articleBox.Contents = ""
' Merker für Resetbutton
CURRENT_GRID_LINE_INDEX = 0
PRINT_DOCUMENT_AFTER_COMPLETION = True
SetLabelText TEXT_CONFIG_INFO, 495, 71, ""
' Arrays reinitialisieren
Redim ORDER_ARTICLE_DATA(MAX_ORDER_COLUMN_COUNT, -1)
Redim MACRO_ARTICLE_LIST(MAX_MACRO_COLUMN_COUNT, -1)
Redim DUPL_ARTICLE_LIST(MAX_DUPL_COLUMN_COUNT, -1)
MacroCommands.MSetFieldFocus WINDOW_ID, ORDER_INPUT
End Sub

62
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/TestArticleHasSerialNumberRegex.vbm Normal file
View File

@@ -0,0 +1,62 @@
' TestArticleHasSerialNumberRegex(Identifier: String)
' ----------------------------------------------------------------------------
' Findet Artikelnummer anhand von versch. Kriterien
' - Artikel-Nummer, Alternative Artikel-Nummer, EAN-Code, Seriennummer
' - Gibt die Zeile im Grid zurück in der Artikel das erste Mal gefunden wurde
'
' Returns: TestArticleHasSerialNumberRegex : Boolean
' ----------------------------------------------------------------------------
' 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: 25.09.2020 / JJ
' Version Date / Editor: 20.07.2021 / MP
' Version Number: 4.0.0.0
Function TestArticleHasSerialNumberRegex(Identifier)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
If DEBUG_ON = True Then
AddDebugLine "Testing for Regex in Identifier: " & Identifier
ShowDebugBox "TestArticleHasSerialNumberRegex"
End If
SQL = ""
' Artikelnummer / EAN-Code / Alternative Artikelnummer
SQL = SQL & "((C002 = '" & Identifier & "') Or (C075 = '" & Identifier & "') Or (C114 = '" & Identifier & "')) AND "
' Serienummer-Regex (Default: C222) muss vorhanden sein
SQL = SQL & "(" & ART_REGEX_FLDBEZ & " IS NOT NULL) AND "
' Artikel darf nicht inaktiv sein
SQL = SQL & "(c038 IS NULL) "
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
If DEBUG_ON = True Then
AddDebugLine "SQL: " & SQL
ShowDebugBox "TestArticleHasSerialNumberRegex"
End If
Set Result = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for SerialNumber-Regex by ArticleNumber " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "TestArticleHasSerialNumberRegex"
End If
If Result.RowCount > 0 Then
TestArticleHasSerialNumberRegex = True
Else
TestArticleHasSerialNumberRegex = False
End If
End Function

37
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/TestHasFreeArticleRow.vbm Normal file
View File

@@ -0,0 +1,37 @@
' TestHasFreeArticleRow(ArticleNumber : String)
' ----------------------------------------------------------------------------
' Sucht die nächste freie Zeile für eine gescannte Seriennummer
'
' Returns: TestHasFreeArticleRow : Boolean
' ----------------------------------------------------------------------------
' 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: 25.09.2020 / JJ
' Version Date / Editor: 25.09.2020 / JJ
' Version Number: 4.0.0.0
Function TestHasFreeArticleRow(ArticleNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Dim NextFreeRow : NextFreeRow = False
If DEBUG_ON = True Then
AddDebugLine "Getting next free row for Article: " & ArticleNumber
ShowDebugBox "TestHasFreeArticleRow"
End If
For GridIndex = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(GridIndex, COLUMN_ARTICLENUMBER)
CurrentSerialNumber = Grid.GetCellValue(GridIndex, COLUMN_SERIALNUMBER)
If UCase(ArticleNumber) = UCase(CurrentArticleNumber) And Len(CurrentSerialNumber) = 0 Then
NextFreeRow = True
Exit For
End If
Next
TestHasFreeArticleRow = NextFreeRow
End Function

43
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/TestIsWebserviceResponseSuccessful.vbm Normal file
View File

@@ -0,0 +1,43 @@
' TestIsWebserviceResponseSuccessful(XmlString : String)
' ----------------------------------------------------------------------------
' Prüft, ob im WebService Result, ein Success enthalten ist
'
' Returns: TestIsWebserviceResponseSuccessful : Boolean
' ----------------------------------------------------------------------------
' 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: 23.10.2020 / JJ
' Version Date / Editor: 23.10.2020 / JJ
' Version Number: 4.0.0.0
Function TestIsWebserviceResponseSuccessful(XmlString)
' Check if XmlString is actually a xml string
If InStr(XmlString, "<?xml") = 1 Then
Set Doc = CreateObject("MSXML2.DOMDocument")
Doc.loadXML(XmlString)
Set Nodes = Doc.SelectNodes("MESOWebServiceResult/ResultDetails")
Set OverallSuccess = Doc.SelectSingleNode("MESOWebServiceResult/OverallSuccess")
If OverallSuccess.Text = "true" Then
Dim IsSuccess : IsSuccess = True
For Each Node in Nodes
Set Success = Node.SelectSingleNode("Success")
If Success.Text <> "true" Then
IsSuccess = False
End If
Next
TestIsWebserviceResponseSuccessful = IsSuccess
Else
TestIsWebserviceResponseSuccessful = False
End If
Else
TestIsWebserviceResponseSuccessful = False
End If
End Function

70
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/TransferGridData.vbm Normal file
View File

@@ -0,0 +1,70 @@
' TransferGridData()
' ----------------------------------------------------------------------------
' Überführt die Gescannten Daten aus dem Grid in die Datenstruktur
'
' Returns: TransferGridData: Boolean
' ----------------------------------------------------------------------------
' 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: 01.09.2021 / JJ
' Version Date / Editor: 25.03.2021 / MP
' Version Number: 4.0.0.0
Function TransferGridData()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
For GridIndex = 1 To Grid.LineCount: Do
Total = Cint(Grid.GetCellValue(GridIndex, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(GridIndex, COLUMN_SCANNED))
ChargeFlag = Cint(Grid.GetCellValue(GridIndex, COLUMN_CHARGE_FLAG)) ' Checkbox-Werte = 0 oder 1
' Zeilennummer aus Auftrag
LineNumber = Cint(Grid.GetCellValue(GridIndex, COLUMN_LINE_NUMBER))
SerialNumber = Grid.GetCellValue(GridIndex, COLUMN_SERIALNUMBER)
MacroFlag = Grid.GetCellValue(GridIndex, COLUMN_MACRO_FLAG)
If Scanned = 0 Then
Exit Do
End If
For OrderArrayIndex = 0 To Ubound(ORDER_ARTICLE_DATA, 2)
If ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = True Then
If ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex) = LineNumber Then
ArraySerialNumber = ORDER_ARTICLE_DATA(INDEX_SERIAL_NUMBER, OrderArrayIndex)
If MacroFlag = 1 Then
For MacroArrayIndex = 0 To UBound(MACRO_ARTICLE_LIST)
If (MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_LINE_NUMBER, MacroArrayIndex) = LineNumber) Then
If (MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_COMPLETE, MacroArrayIndex) = True) Then
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_REMAINING, MacroArrayIndex)
Else
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED, MacroArrayIndex)
End If
Exit For
End If
Next
ElseIf ChargeFlag = 1 And (Len(ArraySerialNumber) = 0 Or ArraySerialNumber = SerialNumber) Then
' Wenn in der Zeile noch keine Seriennummer existiert ODER
' Wenn in der Zeile schon die selbe Seriennummer existiert
ORDER_ARTICLE_DATA(INDEX_SERIAL_NUMBER, OrderArrayIndex) = SerialNumber
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = Scanned
Exit For
ElseIf ChargeFlag = 0 Then
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = Scanned
Exit For
End If
End If
End If
Next
Loop While False: Next
TransferGridData = True
End Function

42
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/TransferMacroData.vbm Normal file
View File

@@ -0,0 +1,42 @@
' TransferMacroData()
' ----------------------------------------------------------------------------
' Überführt die Daten aus dem Macro-Array zurück ins Grid
'
' 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: 08.03.2021 / MP
' Version Date / Editor: 08.03.2021 / MP
' Version Number: 4.0.0.0
Sub TransferMacroData()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
For GridIndex = 1 To Grid.LineCount: Do
MacroFlag = Cint(Grid.GetCellValue(GridIndex, COLUMN_MACRO_FLAG))
If MacroFlag = 1 Then
LineNumber = Cint(Grid.GetCellValue(GridIndex, COLUMN_LINE_NUMBER))
For MacroArrayIndex = 0 To UBound(MACRO_ARTICLE_LIST, 2)
' Wenn die Menge in COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED > 0 ist,
' dann muss dieser Wert ins Grid zurück geschrieben werden.
If (MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_LINE_NUMBER, MacroArrayIndex) = LineNumber) And _
(MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED, MacroArrayIndex) > 0) Then
Grid.SetCellValue GridIndex, COLUMN_SCANNED, MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED, MacroArrayIndex)
Exit For
End If
Next
Else
' Continue
Exit Do
End If
Loop While False: Next
End Sub

64
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/UpdateArticleMasterData.vbm Normal file
View File

@@ -0,0 +1,64 @@
' UpdateArticleMasterData() // NICHT MEHR VERWENDET
' ----------------------------------------------------------------------------
' Stellt Methoden für das Aktualisieren der t024 (Artikel Stammdatei) bereit
'
' 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: 16.02.2022 / MP/JJ
' Version Date / Editor: 16.02.2022 / MP/JJ
' Version Number: 4.0.0.0
Sub UpdateArticleSN(ArtikelNr, PseudoSN, RealSN)
Set Conn = CWLStart.Connection
Err.Clear
Dim UpdateSQL : UpdateSQL = ""
UpdateSQL = UpdateSQL & "UPDATE dbo.t024 "
UpdateSQL = UpdateSQL & "SET [c068] = '" & RealSN & "' WHERE "
UpdateSQL = UpdateSQL & "c011 = '" & ArtikelNr & "' AND "
UpdateSQL = UpdateSQL & "c068 = '" & PseudoSN & "' AND "
UpdateSQL = UpdateSQL & "mesocomp = '" & MandatorNr & "' AND "
UpdateSQL = UpdateSQL & "mesoyear = '" & mesoyear & "'"
Result = Conn.ExecuteSQL(UpdateSQL)
If Result = False Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - UpdatePacktischHistoryRow"
Exit Sub
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - UpdatePacktischHistoryRow"
Exit Sub
End If
End If
End Sub

97
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/UpdateArticleRow.vbm Normal file
View File

@@ -0,0 +1,97 @@
' UpdateArticleRow(RowNumber: Integer)
' ----------------------------------------------------------------------------
' Trägt die gescannte Menge eines Artikel in das Grid ein
' - Ändert die Farbe, abhängig von Gesamtmenge und Gescannte Menge
' - Überprüft, ob der Artikel in der Gescannten Menge auf Lager liegt
'
' Returns: UpdateArticleRow : Boolean
' ----------------------------------------------------------------------------
' 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: 01.09.2021 / JJ
' Version Date / Editor: 25.03.2021 / MP
' Version Number: 4.0.0.0
' Aktualisiert den Wert COLUMN_MACRO_ARTICLE_SCAN_FLAG für den aktuellen
' MacroIndex
Sub UpdateMacroArticleRow(MacroArticleLineNumber)
For MacroArrayIndex = 0 To UBound(MACRO_ARTICLE_LIST): Do
If MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_LINE_NUMBER, MacroArrayIndex) = MacroArticleLineNumber Then
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_SCAN_FLAG, MacroArrayIndex) = True
Exit For
End If
Loop While False: Next
End Sub
Function UpdateArticleRow(RowNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
' Bereits gescannte, Gesamt und Anzahl zu Scannen auslesen
ArticleNumber = Grid.GetCellValue(RowNumber, COLUMN_ARTICLENUMBER)
Total = Cint(Grid.GetCellValue(RowNumber, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(RowNumber, COLUMN_SCANNED))
ScannedAmount = Cint(amountBox.Contents)
MacroFlag = Cint(Grid.GetCellValue(RowNumber, COLUMN_MACRO_FLAG))
MacroArticleLineNumber = Cint(Grid.GetCellValue(RowNumber, COLUMN_MACRO_LINE_NUMBER))
' Standard Rückgabewert setzen
UpdateArticleRow = True
' Aktuellen Lagerstand abfragen
StockedAmount = GetWinLineStockedAmount(ArticleNumber, False)
' Neue bereits gescannte berechnen
NewScanned = Scanned + ScannedAmount
If DEBUG_ON = True Then
AddDebugLine "Total " & Total
AddDebugLine "Scanned: " & Scanned
AddDebugLine "NewScanned: " & NewScanned
AddDebugLine "StockedAmount: " & StockedAmount
ShowDebugBox "UpdateArticleRow"
End If
' Zeilenfarbe anpassen:
' GRÜN: Komplett gescannt
' GELB: Teilweise gescannt
If NewScanned > StockedAmount Then
Message = ""
Message = Message & "Der Artikel ist nur in der Menge " & StockedAmount & " vorhanden." & vbNewline
Message = Message & "Der Scan wird abgebrochen!"
Msgbox Message, vbExclamation, DEFAULT_TITLE
Elseif NewScanned = Total Then
If MacroFlag = 2 Then
Grid.SetLineColor RowNumber, COLOR_PACKAGE_GREEN
UpdateMacroArticleRow(MacroArticleLineNumber)
ReduceSubMacroCounterInDuplList ArticleNumber, MacroArticleLineNumber
Else
Grid.SetLineColor RowNumber, COLOR_GREEN
End If
Grid.SetCellValue RowNumber, COLUMN_SCANNED, NewScanned
ReduceCounterInDuplList ArticleNumber, MacroFlag
Elseif NewScanned < Total Then
If MacroFlag = 2 Then
Grid.SetLineColor RowNumber, COLOR_PACKAGE_YELLOW
UpdateMacroArticleRow(MacroArticleLineNumber)
Else
Grid.SetLineColor RowNumber, COLOR_YELLOW
End If
Grid.SetCellValue RowNumber, COLUMN_SCANNED, NewScanned
Else
Message = ""
Message = Message & "Die eingegebene Menge überschreitet die Gesamtanzahl oder" & vbNewline
Message = Message & "der Artikel wurde bereits vollständig gescannt!"
Msgbox Message, vbExclamation, DEFAULT_TITLE
UpdateArticleRow = False
End If
End Function

51
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/UpdateDeliveryNote.vbm Normal file
View File

@@ -0,0 +1,51 @@
' UpdateDeliveryNote(OrderNumber: String)
' ----------------------------------------------------------------------------
' Füllt zusätzliche Felder in der Tabelle t025 (Belegkopf)
' - User ID (FLD_BENUTZERNUMMER_PACKTISCH)
' - Datum und Uhrzeit der LS-Erzeugung (FLD_ERSTELLDATUM_PACKTISCH)
' - Name des Computers an dem der Packtisch läuft (FLD_COMPUTERNAME_PACKTISCH)
' - Packtischversion (FLD_VERSION_PACKTISCH)
'
' 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: 26.04.2021 / MP
' Version Date / Editor: 23.06.2021 / MP
' Version Number: 4.0.0.0
Sub UpdateDeliveryNote(OrderNumber)
Err.Clear
If USE_ADDITIONAL_DBFIELDS = False Then
Exit Sub
End If
Dim SQL : SQL = ""
Dim NowObject : NowObject = Now
Dim UserNumber : UserNumber = CWLStart.CurrentUser.Number
Dim DateString : DateString = Year(NowObject) & "-" & GetLeftPad(Month(NowObject)) & "-" & GetLeftPad(Day(NowObject))
Dim TimeString : TimeString = GetLeftPad(Hour(NowObject)) & ":" & GetLeftPad(Minute(NowObject)) & ":" & GetLeftPad(Second(NowObject))
Dim ComputerName : ComputerName = GetWindowsEnvironment("COMPUTERNAME")
SQL = SQL & " UPDATE t025 SET "
SQL = SQL & FLD_BENUTZERNUMMER_PACKTISCH & " = " & UserNumber & ", "
SQL = SQL & FLD_ERSTELLDATUM_PACKTISCH & " = '" & DateString & " " & TimeString & "', "
SQL = SQL & FLD_COMPUTERNAME_PACKTISCH & " = '" & ComputerName & "', "
SQL = SQL & FLD_VERSION_PACKTISCH & " = '" & PACKTISCH_VERSION & "' "
SQL = SQL & " WHERE c000 = (SELECT TOP 1 c000 FROM t025 WHERE c029 IS NOT NULL AND c044 = '" & OrderNumber & "' " & SQLQuery_OrderWhere & " ORDER BY ts DESC) " & SQLQuery_OrderWhere
If DEBUG_ON = True Then
AddDebugLine "SQL: " & SQL
ShowDebugBox "UpdateDeliveryNote"
End If
CWLStart.Connection.ExecuteSQL(SQL)
If err <> 0 Then
MsgBox "Fehler beim Updaten des Lieferscheins: " & err.number & " - " & err.description
End If
End Sub

73
archive/Modules/Sicherungen/Modules_20230623/Packtisch_4_0/UpdateOrderDataBeforeDelNote.vbm Normal file
View File

@@ -0,0 +1,73 @@
' UpdateOrderDataBeforeDelNote()
' ----------------------------------------------------------------------------
' Vor der Erstellung des Lieferscheins, können hier noch
' Werte in der Datenstruktur korrigiert werden.
'
' Beispiel: Versandkosten in Package-Artikeln
'
' 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: 08.03.2021 / JJ
' Version Date / Editor: 24.06.2021 / MP
' Version Number: 4.0.0.0
Sub UpdateOrderDataBeforeDelNote()
Dim MacroAmountFaktor
Dim MacroComplete
Dim MacroAmountScanned
For OrderArrayIndex = 0 To Ubound(ORDER_ARTICLE_DATA, 2)
If DEBUG_ON = True Then
AddDebugLine "Current ORDER_ARTICLE_DATA values for Index: " & OrderArrayIndex
AddDebugLine "LineNumber: " & vbTab & ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex)
AddDebugLine "ArticleNumber: " & vbTab & ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex)
AddDebugLine "MacroFlag: " & vbTab & ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex)
AddDebugLine "ProductGroup: " & vbTab & ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex)
AddDebugLine "AmountOrdered: " & vbTab & ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex)
AddDebugLine "AmountDelivered: " & vbTab & ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex)
AddDebugLine "AmountScanned: " & vbTab & ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex)
ShowDebugBox "UpdateOrderDataBeforeDelNote"
End If
MacroFlag = CInt(ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex))
' Wenn Macro-Artikel nur zum Teil ausgeliefert werden,
' müssen die Anteile Nicht-scannbarer Artikel entsprechend reduziert werden.
If MacroFlag = 1 Then
MacroAmount = Cint(ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex)) - Cint(ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex))
MacroAmountScannend = Cint(ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex))
If MacroAmount > MacroAmountScannend Then
MacroComplete = False
If MacroAmount > 0 Then
MacroAmountFaktor = MacroAmountScannend / MacroAmount
End If
Else
MacroComplete = True
MacroAmountFaktor = 1
End If
ElseIf MacroFlag = 2 And MacroComplete = False Then
ProductGroup = Cint(ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex))
' Wir müssen nur etwas tun, wenn ein Faktor < 1 (=100%) ermittelt wurde,
' da die Artikel der ProductGroup aus den EXCLUDED_ARTICLEGROUPS ja bereits vollständig initialisiert werden.
If CheckArticleGroupIsRelevant(ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex)) = False And MacroAmountFaktor < 1 Then
ProductAmount = Cint(ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex)) - Cint(ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex))
ProductAmount = Round(ProductAmount * MacroAmountFaktor)
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = ProductAmount
End If
End If
Next
End Sub

32
archive/Modules/Sicherungen/Modules_20230623/PrettyPrintXmlString.vbs Normal file
View File

@@ -0,0 +1,32 @@
' prettyXml(sDirty : String)
' ----------------------------------------------------------------------------
' Source: https://stackoverflow.com/questions/25067839/format-xml-string-in-vbscript
'
' Returns: prettyXml : String
' ----------------------------------------------------------------------------
' 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: 30.09.2020 / XX
' Version Date / Editor: 30.09.2020 / XX
' Version Number: 1.0.0.0
Function prettyXml(ByVal sDirty)
' Put whitespace between tags. (Required for XSL transformation.)
sDirty = Replace(sDirty, "><", ">" & vbCrLf & "<")
' Create an XSL stylesheet for transformation.
Dim objXSL : Set objXSL = WScript.CreateObject("Msxml2.DOMDocument")
objXSL.loadXML "<xsl:stylesheet version=""1.0"" xmlns:xsl=""http://www.w3.org/1999/XSL/Transform"">" & _
"<xsl:output method=""xml"" indent=""yes""/>" & _
"<xsl:template match=""/"">" & _
"<xsl:copy-of select="".""/>" & _
"</xsl:template>" & _
"</xsl:stylesheet>"
' Transform the XML.
Dim objXML : Set objXML = WScript.CreateObject("Msxml2.DOMDocument")
objXML.loadXml sDirty
objXML.transformNode objXSL
prettyXml = objXML.xml
End Function

52
archive/Modules/Sicherungen/Modules_20230623/RemoveDuplicatesFromArray.vbs Normal file
View File

@@ -0,0 +1,52 @@
' RemoveDuplicatesFromArray(arrItems : Array)
' ----------------------------------------------------------------------------
' Entfernt doppelte Einträge aus Ein-Dimensionalen Arrays
'
' Source: https://devblogs.microsoft.com/scripting/how-can-i-delete-duplicate-items-from-an-array/
'
' Returns: RemoveDuplicatesFromArray : Array
' ----------------------------------------------------------------------------
' 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: 10.08.2020 / MK
' Version Date / Editor: 10.08.2020 / MK
' Version Number: 1.0.0.0
Function RemoveDuplicatesFromArray(arrItems)
If (Ubound(arrItems) >= 0) Then
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MSGBOX "Array count: " & (Ubound(arrItems)+1),,"DEBUG - Info: BEFORE deduplication!"
End If
Set objDictionary = CreateObject("Scripting.Dictionary")
For Each strItem in arrItems
If Not objDictionary.Exists(strItem) Then
objDictionary.Add strItem, strItem
End If
Next
intItems = objDictionary.Count - 1
ReDim arrItems(intItems)
i = 0
For Each strKey in objDictionary.Keys
arrItems(i) = strKey
i = i + 1
Next
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MSGBOX "Array count: " & (Ubound(arrItems)+1),,"DEBUG - Info: AFTER deduplication!"
End If
End If
RemoveDuplicatesFromArray = arrItems
End Function

35
archive/Modules/Sicherungen/Modules_20230623/SendHTTPRequest.vbs Normal file
View File

@@ -0,0 +1,35 @@
' SendHTTPRequest(URL : String)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: SendHTTPRequest : String
' ----------------------------------------------------------------------------
' 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: 10.08.2020 / MK
' Version Date / Editor: 10.08.2020 / MK
' Version Number: 1.0.0.0
Function SendHTTPRequest(URL)
'Create the array for the return values of this function
Dim HTTPRequest(1)
Set Request = CreateObject("MSXML2.XMLHTTP")
Request.Open "POST", URL, False
Request.Send
HTTPRequest(0) = Request.ResponseText
HTTPRequest(1) = Request.Status
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
AddDebugLine "Response from WebServices!"
AddDebugLine "Status: " & HTTPRequest(1)
AddDebugLine "Body: " & HTTPRequest(0)
ShowDebugBox "WebServices"
End If
SendHTTPRequest = HTTPRequest
End Function

24
archive/Modules/Sicherungen/Modules_20230623/SetLabelText.vbm Normal file
View File

@@ -0,0 +1,24 @@
' SetLabelText(LabelItemID : Short, View: Long, Var: Long, Value: String)
' ----------------------------------------------------------------------------
' Setzt den Text eines Labels im aktuellen Fenster
'
' 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: 01.09.2020 / JJ
' Version Date / Editor: 24.02.2021 / MP
' Version Number: 3.0.0.0
Sub SetLabelText(LabelItemID, View, Var, Value)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set labelBox = mywin.Controls.Item(LabelItemID)
CWLCurrentWindow.ActiveWindow.Vars.Value(View, Var) = Value
labelBox.Refresh
End Sub

9
archive/Modules/Sicherungen/Modules_20230623/SetWinLineDocProductStorage.vbs Normal file
View File

@@ -0,0 +1,9 @@
Sub ShowWinLineDocForEditing
'Version Date 22.09.2020
'Call "Beleg" Window
End Sub

19
archive/Modules/Sicherungen/Modules_20230623/ShowDebugBox.vbs Normal file
View File

@@ -0,0 +1,19 @@
' ShowDebugBox(Title : String)
' ----------------------------------------------------------------------------
' Zeigt die DEBUG-MsgBox an
'
' 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: 10.08.2020 / XX
' Version Date / Editor: 10.08.2020 / XX
' Version Number: 1.0.0.0
Sub ShowDebugBox(Title)
MsgBox DEBUG_MESSAGE, vbOkonly, DEBUG_TITLE & " - " & Title
DEBUG_MESSAGE = ""
End Sub

29
archive/Modules/Sicherungen/Modules_20230623/ShowWinLineDocForEditing.vbs Normal file
View File

@@ -0,0 +1,29 @@
' ShowWinLineDocForEditing
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' 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.09.2020 / XX
' Version Date / Editor: 22.09.2020 / XX
' Version Number: 1.0.0.0
Sub ShowWinLineDocForEditing
'Call "Beleg" Window
MChangeGridCell 774, 125, 458753
MGridLeftClick 774, 125, 1, 7
MChangeGridCell 774, 125, 458753
MChangeGridCell 774, 125, 327682
MGridLeftClick 774, 125, 2, 5
MChangeGridCell 774, 125, 458753
MGridLeftClick 774, 125, 1, 7
MPushButton 774, 134, 0
End Sub

46
archive/Modules/Sicherungen/Modules_20230623/ShowWinLineDocOverview.vbs Normal file
View File

@@ -0,0 +1,46 @@
' ShowWinLineDocOverview(DocNumber : String, AccountNumber : String, RunningNumber : String)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' 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.09.2020 / XX
' Version Date / Editor: 22.09.2020 / XX
' Version Number: 1.0.0.0
Sub ShowWinLineDocOverview(DocNumber, AccountNumber, RunningNumber)
'Call "Beleg" Window
MApplication 2
MWindow 774, false
MTreeExpand 774, 102, 321566992, 100
MTreeSelChange 774, 102, 321566992, 1001
MActivateWindow 774
IF (DocNumber <> "") and (AccountNumber <> "") and (RunningNumber <> "") Then
'Set time periode (12 = alle Jahre)
MSetFieldValue 774, 105, "12"
'Set area (1 = Verkauf/Einkauf)
MSetFieldValue 774, 107, "1"
'Set Account number (Kundennummern)
MSetFieldValue 774, 115, AccountNumber
'Set doc number (Belegnummer)
MSetFieldValue 774, 117, DocNumber
'Set Running Nr (Laufnummer)
MSetFieldValue 774, 191, RunningNumber
'Click the ok Button
MPushButton 774, 98, 0
End If
End Sub

35
archive/Modules/Sicherungen/Modules_20230623/ShowWinLineMandatorAndWinLineYear.vbs Normal file
View File

@@ -0,0 +1,35 @@
' ShowWinLineMandatorAndWinLineYear(WinLineMandatorNr : String, WinLineYear : String)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' 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.09.2020 / XX
' Version Date / Editor: 22.09.2020 / XX
' Version Number: 1.0.0.0
Sub ShowWinLineMandatorAndWinLineYear(WinLineMandatorNr, WinLineYear)
'Close all Windows
MPushButton 774, 99, 0
IF (WinLineMandatorNr <> "") and (WinLineYear <> "") Then
Dim Year
Year = (WinLineYear / 12) + 1900
'Close all Windows
'MActivateWindow 85
'MPushButton 85, 99, 0
MActivateWindow 774
MPushButton 774, 99, 0
End If
End Sub

27
archive/Modules/Sicherungen/Modules_20230623/ShowWinLineProgramMacros.vbs Normal file
View File

@@ -0,0 +1,27 @@
' ShowWinLineProgramMacros
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' 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: 23.09.2020 / XX
' Version Date / Editor: 23.09.2020 / XX
' Version Number: 1.0.0.0
Sub ShowWinLineProgramMacros
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
'Return to Macro Window
MApplication 2
MApplication 0
MWindow 45, False
MSetFieldFocus 45, 100
MSetFieldFocus 45, -1
MActivateWindow 45
MSetFieldValue 45, 121, CWLMacro.MName
End If
End Sub

Some files were not shown because too many files have changed in this diff Show More