8
0

Anlage des Repos

This commit is contained in:
2024-01-24 16:42:38 +01:00
commit 38d6a271c4
1785 changed files with 3051496 additions and 0 deletions

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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