418 lines
16 KiB
Plaintext
418 lines
16 KiB
Plaintext
' 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
|
|
|
|
' 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 "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 |