8
0

Module: Reorg / Cleanup

This commit is contained in:
2024-11-08 15:39:19 +01:00
parent 36ef16eb34
commit 294debc67c
226 changed files with 436 additions and 0 deletions

View File

@@ -1,3 +0,0 @@
Sub AddDebugLine(Message)
DEBUG_MESSAGE = DEBUG_MESSAGE & Message & vbNewLine
End Sub

View File

@@ -1,268 +0,0 @@
Function GetWinLineDocInfoByAccountAndRunningNr(DocAccountAndRunningNr, PostingType, WinLineDocType)
'Stand 25.08.2020
On Error Resume Next
'Set SQL Table and Query for DocHead. Default: "T025"
SQLTable_DocHead = "[T025]"
SQLQuery_DocHead = "c000 = '" & DocAccountAndRunningNr & "'" & SQLQuery_BasicWhere
'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_BasicWhere
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_BasicWhere
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

View File

@@ -1,41 +0,0 @@
Function GetWinLineOriginalLineNumber(OrderNumber, ArticleNumber, IsSerialNumberArticle)
Set Conn = CWLStart.CurrentCompany.Connection
If IsSerialNumberArticle = 1 Then
SQL = "SELECT TOP 1 c078 FROM t026 (NOLOCK) "
SQL = SQL & "WHERE c067 = '"& OrderNumber &"' AND c003 = '"& ArticleNumber &"' "
SQL = SQL & SQLQuery_BasicWhere
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

View File

@@ -1,75 +0,0 @@
Function GetWinLineStorageLocation(ProductNumber, ProductSerialNumber, IsSerialNumberArticle)
Set Conn = CWLStart.CurrentCompany.Connection
' Get 'Lagerortstruktur' for Product
SQL = "SELECT c178 FROM [V021] (NOLOCK) WHERE c010 = '"& ProductNumber &"'"
Set Result = Conn.Select(SQL)
If Result.Value("c178") = 0 Then
GetWinLineStorageLocation = 0
Exit Function
End If
If IsSerialNumberArticle = 1 Then
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 & ") 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 & ") 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 & ") 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 & ") 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 & ") L5 "
SQL = SQL & "WHERE T299.C000 = '"& GetWinLineInternalProductNumber(ProductNumber, ProductSerialNumber) &"' AND T299.C000 = T024.C002 AND T299.MESOCOMP = '" & MandatorNr & "' AND T299.MESOYEAR = " & WinLineCurrentYear & " AND T024.MESOCOMP = '" & MandatorNr & "' "
SQL = SQL & "AND T024.MESOYEAR = " & WinLineCurrentYear & " AND T335.MESOCOMP = '" & MandatorNr & "' AND T335.MESOYEAR = " & WinLineCurrentYear & " 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"
Else
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 & ") 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 & ") 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 & ") 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 & ") 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 & ") L5 "
SQL = SQL & "WHERE T299.C000 = '"& ProductNumber &"' AND T299.C000 = T024.C002 AND T299.MESOCOMP = '" & MandatorNr & "' AND T299.MESOYEAR = " & WinLineCurrentYear & " AND T024.MESOCOMP = '" & MandatorNr & "' "
SQL = SQL & "AND T024.MESOYEAR = " & WinLineCurrentYear & " AND T335.MESOCOMP = '" & MandatorNr & "' AND T335.MESOYEAR = " & WinLineCurrentYear & " 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"
End If
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 < 0 Then
' If err <> 0 Then
' Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - GetWinLineStorageLocation"'
' Exit Function
' Else
' Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - GetWinLineStorageLocation"
' Exit Function
' End If
' End If
GetWinLineStorageLocation = Result.Value("c000")
End Function

View File

@@ -1,194 +0,0 @@
'Function to load VBS modules
Public Function LoadVBSModule(VBSModuleParams)
'SYNOPSIS
'Function will load external - additional - VBS Modules into current Script.
'DESCRIPTION
'By working With Modules, this Function Is necessary To load external Modul 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
'"VBSModuleParams(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, ModuleName, ModuleCode, ModulePath, WshShell, ModuleAutoSourcePath
'REQUIREMENT Variables preSet
'ModuleDefaultSourcePath (optional)
'REQUIREMENT Functions
'<NONE>
'VERSION
'Number: 1.3.0.1 / Date: 29.08.2020
'PARAMETER VBSModuleParams(0) = ModuleName
'Give the Module Name, you want to load into the current VB-Script.
'PARAMETER VBSModuleParams(1) = ModuleOverrideSourcePath
'Optional Parameter. By giving the ModuleOverrideSourcePath, Function will not check other Paths for the Function you want to load.
'EXAMPLE
'Dim VBSModuleParams
'Redim VBSModuleParams(0)
'VBSModuleParams(0) = Module
'LoadVBSModule(VBSModuleParams)
'EXAMPLE
'Dim VBSModuleParams
'Redim VBSModuleParams(1)
'VBSModuleParams(0) = Module
'VBSModuleParams(1) = "D:\ScriptFiles\Modules"
'LoadVBSModule(VBSModuleParams)
On Error Resume Next
'Clear Error Variable
Err.Clear
Dim FSOModule, Module, ModuleName, ModuleCode, ModulePath, WshShell, ModuleAutoSourcePath
Set FSOModule = CreateObject("Scripting.FileSystemObject")
'How many parameters are given in the array
If (UBound(VBSModuleParams) = 0) Then
ModuleName = VBSModuleParams(0)
If FSOModule.FolderExists(ModuleDefaultSourcePath) Then
'If global var is set, take it!
ModulePath = ModuleDefaultSourcePath
ELSE
'Getting the current dir, when ModuleDefaultSourcePath does not exist
Set WshShell = CreateObject("WScript.Shell")
ModuleAutoSourcePath = WshShell.CurrentDirectory
'By this parameter way the path is more variable
ModulePath = ModuleAutoSourcePath & "\" & "Modules"
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MSGBOX "Parameter1 = " & VBSModuleParams(0) & vbCrlf & _
"ModuleDefaultSourcePath = " & ModuleDefaultSourcePath,,"DEBUG Info: Parameter Values in Array - VBSModuleParams"
End If
End if
ElseIf (UBound(VBSModuleParams) = 1) Then
ModuleName = VBSModuleParams(0)
ModulePath = VBSModuleParams(1)
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MSGBOX "Parameter1 = " & VBSModuleParams(0) & vbCrlf & _
"Parameter2 = " & VBSModuleParams(1),,"DEBUG Info: Parameter Values in Array - VBSModuleParams"
End If
Else
msgbox "Invalid function call!" & vbCrlf & _
"Please check the parameters!" & vbCrlf & _
"...then restart this Script!",vbExclamation ,"LoadVBSModule: Parameter Error!"
End if
'Checking folder paths 'Check if given path is valid, if not create it
If Not FSOModule.FolderExists(ModulePath) Then
FSOModule.CreateFolder(ModulePath)
msgbox "The ModulePath doesnt exist, trying to create!" & vbCrlf & _
"Please place your Modules there: " & vbCrlf & _
ModulePath & vbCrlf & vbCrlf & _
"...then restart this Script!",vbExclamation ,"LoadVBSModule: Modules / ModulePath is missing!"
Else
'Clear Error Variable
Err.Clear
'Building full module path and name
ModuleFullName = ModulePath & "\" & Modulename & ".vbs"
'does the file exist?
If Not FSOModule.FileExists(ModuleFullName) Then
If Err.Number <> 0 Then
MSGBOX "Error Code: "& Err.Number & vbCrlf & _
"Error Description: "& Err.Description,,"ERROR: Module does not exist! "
Err.Clear
LoadVBSModule = "False"
End If
Else
'Open file
Set Module = FSOModule.OpenTextFile(ModuleFullName, 1)
'Get file content
ModuleCode = Module.ReadAll
'Close file handle
Module.Close
'Execute the file content
ExecuteGlobal ModuleCode
If Err.Number <> 0 Then
MSGBOX "Error Code: "& Err.Number & vbCrlf & _
"Error Description: "& Err.Description,,"ERROR: Module cannot be loaded!"
Err.Clear
LoadVBSModule = "False"
Else
LoadVBSModule = "True"
End If
End If
End If
End Function 'LoadVBSModule
'------------------------------------ EXAMPLE TO CALL THE FUNCTION ------------------------------------
'Prepare Array (Arrays are zero based!)
Modules = Array("TestModule1","TestModule2","TestModule3")
Dim Module
'Load external Modules.
For Each Module In Modules
'Create the array to pass in to our function
Dim VBSModuleParams
'Call the subroutine with two arguments
Redim VBSModuleParams(0) 'Change to 1, for 2 values
VBSModuleParams(0) = Module
'VBSModuleParams(1) = ""
LoadVBSModuleResult = LoadVBSModule(VBSModuleParams)
If (LoadVBSModuleResult <> "True") Then
'Set WScript = CreateObject("WScript.Shell")
MSGBOX "Module: " & Module & " was Not succesful been loaded!" & vbCrlf & _
"Please load the Module and try again, running this Function/Module!" & vbCrlf & _
"Exiting, because of this Issue." & vbCrlf & _
Err.Description, vbCritical, "DEBUG Info: Cannot load Module!"
'WScript.Quit = not possible in Winline enviroment
End If
Next 'end for each
TestModule1
TestModule2
TestModule3
'------------------------------------------------------------------------------------------------------

View File

@@ -1,227 +0,0 @@
'Function to load VBS modules
Public Function LoadVBSModule(VBSModuleParams)
'SYNOPSIS
'Function will load external - additional - VBS Modules (VBM or VBS File(s)) into current Script.
'DESCRIPTION
'By working With Modules, this Function Is necessary To load external Modul 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
'"VBSModuleParams(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, ModuleName, ModuleCode, ModulePath, WshShell, ModuleAutoSourcePath
'REQUIREMENT Variables preSet
'ModuleDefaultSourcePath (optional)
'REQUIREMENT Functions
'<NONE>
'VERSION
'Number: 1.5.0.2 / Date: 17.06.2021
'PARAMETER VBSModuleParams(0) = ModuleName
'Give the Module Name, you want to load into the current VB-Script.
'PARAMETER VBSModuleParams(1) = ModuleOverrideSourcePath
'Optional Parameter. By giving the ModuleOverrideSourcePath, Function will not check other Paths for the Function you want to load.
'EXAMPLE
'Dim VBSModuleParams
'Redim VBSModuleParams(0)
'VBSModuleParams(0) = Module
'LoadVBSModule(VBSModuleParams)
'EXAMPLE
'Dim VBSModuleParams
'Redim VBSModuleParams(1)
'VBSModuleParams(0) = Module
'VBSModuleParams(1) = "D:\ScriptFiles\Modules"
'LoadVBSModule(VBSModuleParams)
On Error Resume Next
'Clear Error Variable
Err.Clear
Dim FSOModule, Module, ModuleName, ModuleCode, ModulePath, WshShell, ModuleAutoSourcePath
Set FSOModule = CreateObject("Scripting.FileSystemObject")
'How many parameters are given in the array
If (UBound(VBSModuleParams) = 0) Then
ModuleName = VBSModuleParams(0)
If FSOModule.FolderExists(ModuleDefaultSourcePath) Then
'If global var is set, take it!
ModulePath = ModuleDefaultSourcePath
ELSE
'Getting the current dir, when ModuleDefaultSourcePath does not exist
Set WshShell = CreateObject("WScript.Shell")
ModuleAutoSourcePath = WshShell.CurrentDirectory
'By this parameter way the path is more variable
ModulePath = ModuleAutoSourcePath & "\" & "Modules"
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MSGBOX "Parameter1 = " & VBSModuleParams(0) & vbCrlf & _
"ModuleDefaultSourcePath = " & ModuleDefaultSourcePath,,"DEBUG Info: Parameter Values in Array - VBSModuleParams"
End If
End if
ElseIf (UBound(VBSModuleParams) = 1) Then
ModuleName = VBSModuleParams(0)
ModulePath = VBSModuleParams(1)
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MSGBOX "Parameter1 = " & VBSModuleParams(0) & vbCrlf & _
"Parameter2 = " & VBSModuleParams(1),,"DEBUG Info: Parameter Values in Array - VBSModuleParams"
End If
Else
msgbox "Invalid function call!" & vbCrlf & _
"Please check the parameters!" & vbCrlf & _
"...then restart this Script!",vbExclamation ,"LoadVBSModule: Parameter Error!"
End if
'Checking folder paths 'Check if given path is valid, if not create it
If Not FSOModule.FolderExists(ModulePath) Then
FSOModule.CreateFolder(ModulePath)
msgbox "The ModulePath doesnt exist, trying to create!" & vbCrlf & _
"Please place your Modules there: " & vbCrlf & _
ModulePath & vbCrlf & vbCrlf & _
"...then restart this Script!",vbExclamation ,"LoadVBSModule: Modules / ModulePath is missing!"
Else
'Clear Error Variable
Err.Clear
'does the file exist? vbm is preferred!
If FSOModule.FileExists((ModulePath & "\" & Modulename & ".vbm")) Then
'Building full module path and name
ModuleFullName = ModulePath & "\" & Modulename & ".vbm"
'does the file exist?
Elseif FSOModule.FileExists((ModulePath & "\" & Modulename & ".vbs")) Then
'Building full module path and name
ModuleFullName = ModulePath & "\" & Modulename & ".vbs"
Else
'Otherwise set empty string var
ModuleFullName = Empty
End if
If (ModuleFullName = Empty) Then
MSGBOX "ModulePath cannot be determined! " & vbCrlf & _
"Path: " & ModulePath & "\" & Modulename & vbCrlf & _
"",vbOkayonly+vbCritical,"ERROR: Module does NOT exist! "
Err.Clear
LoadVBSModule = "False"
Else
Set Module = CreateObject("ADODB.Stream")
'IF ADODB object could not be created, fallback
If (Err.Number <> 0) Then
Set Module = FSOModule.OpenTextFile(ModuleFullName, 1)
ModuleCode = Module.ReadAll
Module.Close
Else
Module.CharSet = "utf-8"
Module.Open
Module.LoadFromFile(ModuleFullName)
ModuleCode = Module.ReadText()
Module.Close
End If
Set Module = Nothing
'Execute the file content
ExecuteGlobal ModuleCode
If Err.Number <> 0 Then
MSGBOX "Error Code: " & Err.Number & vbCrlf & _
"Error Description: " & Err.Description & vbCrlf & _
"Path: " & ModuleFullName & vbCrlf & _
"",vbOkayonly+vbCritical,"ERROR: Module cannot be loaded!"
Err.Clear
LoadVBSModule = "False"
Else
LoadVBSModule = "True"
End If
End If
End If
End Function 'LoadVBSModule
'------------------------------------ EXAMPLE TO CALL THE FUNCTION ------------------------------------
''Prepare Array (Arrays are zero based!)
'Modules = Array("TestModule1","TestModule2","TestModule3")
'
' Dim Module
'
' 'Load external Modules.
' For Each Module In Modules
'
' If (Module <> "") Then
'
' 'Create the array to pass in to our function
' Dim VBSModuleParams
'
' 'Call the subroutine with two arguments
' Redim VBSModuleParams(0) 'Change to 1, for 2 values
' VBSModuleParams(0) = Module
' 'VBSModuleParams(1) = ""
'
' LoadVBSModuleResult = LoadVBSModule(VBSModuleParams)
'
' If (LoadVBSModuleResult <> "True") Then
'
' 'Set WScript = CreateObject("WScript.Shell")
' MSGBOX "Module: " & Module & " was Not succesful been loaded!" & vbCrlf & _
' "Please load the Module and try again, running this Function/Module!" & vbCrlf & _
' "Exiting, because of this Issue." & vbCrlf & _
' Err.Description, vbCritical, "DEBUG Info: Cannot load Module!"
' 'WScript.Quit = not possible in Winline enviroment
'
' End If 'LoadVBSModuleResult
'
' End If 'Module <> ""
'
' Next 'end for each
'
'TestModule1
'TestModule2
'TestModule3
'------------------------------------------------------------------------------------------------------

View File

@@ -1,135 +0,0 @@
' 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
' ---------------------------------------------------------
Const ARTICLE_EXISTS_NO_STOCK = -99
Const ARTICLE_EXISTS_NO_SERIALNUMBER = -98
Const ARTICLE_EXISTS_NO_ARTICLE_EAN = -97
Function ArticleExists(Identifier)
ArticleExists = 0
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 & vbNewline
AddDebugLine "Result Columns: " & ResultSeriennummer & vbNewline
AddDebugLine "Result Rows: " & ResultSeriennummer.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
If ResultSeriennummer.RowCount > 0 Then
CURRENT_SERIALNUMBER = Identifier
Set Result = ResultSeriennummer
Else
Set Result = ResultArtikel
End If
'==========================================================
If 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")
' Lagerstand des Artikels prüfen
SQL = ""
SQL = SQL & "SELECT "
SQL = SQL & "(SELECT C008 AS [MengeZugang] from [v021] (NOLOCK) where (c011 = '__ARTICLENUMBER__' OR c002 = '__ARTICLENUMBER__') "& SQLQuery_BasicWhere &") - "
SQL = SQL & "(SELECT C009 AS [MengeAbgang] from [v021] (NOLOCK) where (c011 = '__ARTICLENUMBER__' OR c002 = '__ARTICLENUMBER__') "& SQLQuery_BasicWhere &") - "
SQL = SQL & "ISNULL((SELECT SUM(C035) AS [MengeVerkauf] FROM [t014] (NOLOCK) where c000 = '__ARTICLENUMBER__' "& SQLQuery_BasicWhere &"), 0) AS c000"
SQL = Replace(SQL, "__ARTICLENUMBER__", RealArticleNumber)
Set Result = CWLStart.CurrentCompany.Connection.Select(SQL)
AmountStocked = Result.Value("c000")
If DEBUG_ON = True Then
AddDebugLine "Checking stock of product: " & RealArticleNumber & " (" & MainArticleNumber & ")" & vbNewline & vbNewline
AddDebugLine "Result Columns: " & Result & vbNewline
AddDebugLine "Result Rows: " & Result.RowCount & vbNewline
AddDebugLine "Stock: " & AmountStocked & vbNewLine
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
If AmountStocked > 0 Then
If DEBUG_ON = True Then
AddDebugLine "Amount stocked: " & AmountStocked
ShowDebugBox "ArticleExists"
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 & ")"
ShowDebugBox "ArticleExists"
End If
If Total > Scanned Then
If DEBUG_ON = True Then
AddDebugLine "Product is not yet scanned completetly and exists in Row " & Row & "!"
ShowDebugBox "ArticleExists"
End If
ArticleExists = Row
Exit For
End If
End If
Next
Else
ArticleExists = ARTICLE_EXISTS_NO_STOCK
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

@@ -1,199 +0,0 @@
' CompleteOrder()
' ---------------------------------------------------------
' Schließt die Prüfung ab und erstellt einen Lieferschein
'
' Rückgabewert: Keiner
' ---------------------------------------------------------
Sub 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
OrderId = mywin.Controls.Item(ORDER_INPUT).ScreenContents
AccountSQL = "SELECT DISTINCT c021 FROM t025 (NOLOCK) WHERE c044 = '" & OrderId & "' " & SQLQuery_BasicWhere
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 =====================
HeadSQL = "INSERT INTO " & SQLDB_for_EXIM & "." & SQLHeadTB_for_EXIM & " "
HeadSQL = HeadSQL & "(BELEGKEY, Kontonummer, Laufnummer, Auftragsnummer, Datum_Lieferschein) "
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, AmountDelivered, 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)
LineNumber = GetWinLineOriginalLineNumber(OrderId, ArticleNumber, IsSerialNumberArticle)
StorageLocation = GetWinLineStorageLocation(ArticleNumber, SerialNumber, IsSerialNumberArticle)
AmountDelivered = Grid.GetCellValue(Row, COLUMN_SCANNED)
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', "& AmountDelivered &", '"& 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', "& AmountDelivered &", '"& SerialNumber &"', "& StorageLocation &")"
End If
MidResult = Conn.ExecuteSQL(MidSQL)
If DEBUG_ON = True Then
AddDebugLine "Inserting Middle Data" & vbNewline
AddDebugLine "Result: " & MidResult
AddDebugLine "SQL: " & MidSQL
ShowDebugBox "CompleteOrder"
End If
Next
' ===================== ENDE MITTEDATEN =====================
' ============================ XML ============================
Dim Request, URL, XML
Dim DObj : DObj = Now
Dim DateString : DateString = Year(DObj) & "-" & GetLeftPad(Month(DObj)) & "-" & GetLeftPad(Day(DObj))
XML = ""
XML = XML & "<?xml version=""1.0"" encoding=""UTF-8""?>"
XML = XML & "<MESOWebService TemplateType=""__TYPE__"" Template=""__VORLAGE__"" option=""__OPTION__"" printVoucher=""__PRINT__"">"
' Kopf
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>"
For Row = 1 To Grid.LineCount
ArticleNumber = Grid.GetCellValue(Row, COLUMN_ARTICLENUMBER)
SerialNumber = Grid.GetCellValue(Row, COLUMN_SERIALNUMBER)
LineNumber = GetWinLineOriginalLineNumber(OrderId, ArticleNumber, IsSerialNumberArticle)
StorageLocation = GetWinLineStorageLocation(ArticleNumber, SerialNumber, IsSerialNumberArticle)
AmountDelivered = Grid.GetCellValue(Row, COLUMN_SCANNED)
InternalArticleNumber = GetWinLineInternalProductNumber(ArticleNumber, SerialNumber)
' Mitte
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>" & AmountDelivered & "</Mengegeliefert>"
MidXML = MidXML & "<ChargeIdentnummer>" & SerialNumber & "</ChargeIdentnummer>"
MidXML = MidXML & "<Lagerort>" & StorageLocation & "</Lagerort>"
MidXML = MidXML & "</__VORLAGE__T026>"
If DEBUG_ON = True Then
AddDebugLine "Adding Product Row to XML:" & vbNewLine
AddDebugLine 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, "__OPTION__", WEB_OPTION)
XML = Replace(XML, "__PRINT__", WEB_PRINT)
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
ShowDebugBox "CompleteOrder"
End If
' ======================= ENDE XML =======================
' ===================== 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 InStr(Response, "<OverallSuccess>true</OverallSuccess>") > 0 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 & "Status: " & Status
End If
If Error = False Then
MsgBox Message, vbInformation, DEFAULT_TITLE & " - Abschluss erfolgreich"
MacroCommands.MSetFieldFocus WINDOW_ID, ORDER_INPUT
Else
MsgBox Message, vbExclamation, DEFAULT_TITLE & " - Fehler bei Abschluss"
End If
End Sub

View File

@@ -1,47 +0,0 @@
' 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
SQL = ""
SQL = SQL & "(c044 = '"& OrderNumber &"')"
SQL = SQL & "AND (c025 IN ('M', 'A', 'S'))"
SQL = SQL & SQLQuery_BasicWhere
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
Msgbox "Der Auftrag " & _
OrderNumber & _
" wurde bereits vollständig erledigt oder als abgeschlossen markiert!", _
vbExclamation, DEFAULT_TITLE & " - IsOrderAvailable"
Exit Function
End If
End If
If Result.RowCount > 0 Then
IsOrderAvailable = True
End If
End Function

View File

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

@@ -1,111 +0,0 @@
' 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
' ---------------------------------------------------------
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 &"') "
' Versandkosten (Art.Gruppe 100) rausfiltern
SQL = SQL & "and c012 NOT IN (100) "
' Nur Artikel aus offenen Belegen anzeigen
SQL = SQL & "and c031 = c112"
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
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.." & 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
Do
' Zeilen hochzählen
Amount = Cint(Result.Value("c005"))
ChargeFlag = Cint(Result.Value("c055"))
If ChargeFlag = 2 Then
For index = 1 To Amount
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
Grid.AddLine
' Zeilenfarbe mit ROT vorbelegen
Grid.SetLineColor LineCounter, COLOR_RED
LineCounter = LineCounter + 1
Next
Else
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = Cint(Result.Value("c005"))
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) = 0
' Ergebnisse aus SQL in Zeile schreiben
Grid.AddLine
' Zeilenfarbe mit ROT vorbelegen
Grid.SetLineColor LineCounter, COLOR_RED
LineCounter = LineCounter + 1
End If
If Result.NextRecord = False Then
Exit Do
End If
Loop
LoadOrder = True
Else
MsgBox "Auftrag wurde bereits bearbeitet oder existiert nicht", vbExclamation, DEFAULT_TITLE
LoadOrder = False
End If
Grid.IsRedraw = True
End Function

View File

@@ -1,20 +0,0 @@
Function SerialNumberExists(SerialNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
SerialNumberExists = False
If DEBUG_ON = True Then
AddDebugLine "Checking existence of SerialNumber: " & SerialNumber
ShowDebugBox "SerialNumberExists"
End If
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

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

@@ -1,39 +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 Gescannt
' (495,1) - Menge Gesamt
' (495,2) - Seriennummer
' (495,3) - Artikelnummer
' (495,4) - Bezeichnung
' (495,5) - Chargen-/Identflag
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
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("SN-Artikel", "T17,Artikeltyp", "l","V",0,495,5,5,scrtflag+sizeflag+hideflag)
COLUMNS_CREATED = True
End If
Grid.IsRedraw = True
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
amountBox.Contents = AMOUNT_PLACEHOLDER
MacroCommands.MSetFieldFocus WINDOW_ID, ORDER_INPUT
End Sub

View File

@@ -1,45 +0,0 @@
' UpdateArticleRow(RowNumber: Integer)
' ---------------------------------------------------------
' Trägt die gescannte Menge eines Artikel in das Grid ein
' - Ändert die Farbe, abhängig von Gesamtmenge und Gescannte Menge
'
' Rückgabewert: Keiner
' ---------------------------------------------------------
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
Total = Cint(Grid.GetCellValue(RowNumber, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(RowNumber, COLUMN_SCANNED))
ScannedAmount = Cint(amountBox.Contents)
' Neue bereits gescannte berechnen
NewScanned = Scanned + ScannedAmount
If DEBUG_ON = True Then
AddDebugLine "Total " & Total & vbNewline
AddDebugLine "Scanned: " & Scanned & vbNewline
AddDebugLine "NewScanned: " & NewScanned & vbNewline
ShowDebugBox "UpdateArticleRow"
End If
' Zeilenfarbe anpassen:
' GRÜN: Komplett gescannt
' GELB: Teilweise gescannt
If 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

View File

@@ -1,451 +0,0 @@
Function Read-ConfigFile {
<#
.SYNOPSIS
Function will read the given ConfigFile, and returns Values or creates Profiles.
.DESCRIPTION
This Function will get Script configurations from a ASCII/ANSI based ConfigFile (INI).
The important criterion is, that every Value the should be read, has to look like this: ConfigLabel = ConfigValue
The ConfigFile should be formated within UTF8 and every Line in a ConfigFile which is beginning with a "#", will be ignored!
By calling this Function the first time, it will read the ConfigFile and save its content into the Variable ConfigFileValues.
In the same call or later calls you can instruct this Function to Return a value for a searched pattern (ConfigLabel).
If nothing was found, Function will try to get a FailSafe Setting (predefined global Variable in Script), if even this fails it will Return $NULL.
Depending on the way your calling this Function, it can return a single Value for a searched ConfigLabel like: $LogPath = E:\Logs,
or it can return multiple Values like; $Domains = .*@my-domain.com;'.*@my-second-domain.com',
or it can create multiple Profiles with single or multiple Values and only returning the Count of the created Profiles.
.REQUIREMENT General
PowerShell V2
.REQUIREMENT Assembly
<NONE>
.REQUIREMENT Variables
ConfigFile, ConfigLabel, ConfigValue, ConfigValues, ConfigLinesValue, ConfigLinesValueSeparator, FileTest, Item, Items, ItemValue, ItemValues, ItemValuesTEMP
.REQUIREMENT Variables preSet
ConfigFile
.REQUIREMENT Functions
<NONE>
.VERSION
Number: 2.0.0.0 / Date: 16.02.2017
.PARAMETER ConfigFile
Give the full path to the ConfigFile (eg. <ScriptName>_Settings.ini). (Default: If you dont give it, Function will try the retrieve ConfigFile (Path and Name) from the Global Variables, set by the calling Script.)
.PARAMETER ConfigLabel
Give the ConfigLabel, you are looking for a Value.
.PARAMETER ConfigLinesValue
Optional Parameter. Select "MultiValue", if in one Line are multiple Values (eg. Array List) separated by "$ConfigLinesValueSeparator". (Default: "SingleValue").
.PARAMETER ConfigLinesValueSeparator
Optional Parameter. Which declares the symbol or character for Value separation (Default: ';').
.PARAMETER ConfigLines
Optional Parameter. Select how many Lines from ConfigFile you expect to get returned. Use Values higher than 1, to work with Profiles. If you do, Function will set Variables and just returns how many are created! (Default: 1).
.PARAMETER Force
Optional Parameter. By using the Force Parameter, ConfigFile will be reloaded.
.EXAMPLE
Set-Variable -Scope Global -Name LogPaths -Value (Read-ConfigFile -ConfigFile "<Path>\<ScriptName>_Settings.ini" -ConfigLabel LogPath) -Force
.EXAMPLE
Set-Variable -Scope Global -Name ListofValues -Value (Read-ConfigFile -ConfigLabel ListofValues -ConfigLinesValue MultiValue) -Force
.EXAMPLE
Set-Variable -Scope Global -Name ProfileCount -Value (Read-ConfigFile -ConfigLabel Profile -ConfigLines 999) -Force
.EXAMPLE
Set-Variable -Scope Global -Name ProfileCount -Value (Read-ConfigFile -ConfigLabel Profile -ConfigLines 999 -ConfigLinesValue MultiValue) -Force
.EXAMPLE
Set-Variable -Scope Global -Name ProfileCount -Value (Read-ConfigFile -ConfigLabel Profile -ConfigLines 999 -ConfigLinesValue MultiValue -ConfigLinesValueSeparator |) -Force
#>
Param (
[Parameter(Position=0,Mandatory=$False,HelpMessage='Give the full path to the ConfigFile (eg. <ScriptName>_Settings.ini). (Default: If you dont give it, Function will try the retrieve ConfigFile (Path and Name) from the Global Variables, set by the calling Script.)')]
[ValidateNotNullOrEmpty()]
[String]$ConfigFile=(Get-Variable -Name ConfigFile -Scope Global -ValueOnly),
[Parameter(Position=1,Mandatory=$True,HelpMessage='Give the ConfigLabel, you are looking for a Value.')]
[ValidateNotNullOrEmpty()]
[String]$ConfigLabel=$NULL,
[Parameter(Position=2,Mandatory=$False,HelpMessage='Optional Parameter. Select "MultiValue", if in one Line are multiple Values (eg. Array List) separated by "$ConfigLinesValueSeparator". (Default: "SingleValue").')]
[ValidateSet("SingleValue","MultiValue")]
[String]$ConfigLinesValue="SingleValue",
[Parameter(Position=3,Mandatory=$False,HelpMessage='Optional Parameter. Which declares the symbol or character for Value separation (Default: ";").')]
[ValidateNotNullOrEmpty()]
[String]$ConfigLinesValueSeparator=';',
[Parameter(Position=4,Mandatory=$False,HelpMessage='Optional Parameter. Select how many Lines from ConfigFile you expect to get returned. Use Values higher than 1, to work with Profiles. If you do, Function will set Variables and just returns how many are created! (Default: 1).')]
[ValidateRange(0,1000)]
[Int]$ConfigLines=1,
[Parameter(Position=5,Mandatory=$False,HelpMessage='Optional Parameter. By using the Force Parameter, ConfigFile will be reloaded.')]
[Switch]$Force
) #end param
#Clear Error Variable
$error.clear()
#If ConfigFile wasnt read, do this at first
IF ((($ConfigFile) -and (!$ConfigValues)) -or ($Force -eq $True)) {
Write-Host ""
Write-Host "DEBUG Info - Read-ConfigFile: ConfigFile has not been evaluated jet..."
Write-Host "DEBUG Info - Read-ConfigFile: Checking for ConfigFile: $ConfigFile"
$FileTest = Test-Path -PathType Leaf $ConfigFile
IF ($FileTest -eq $True) {
Write-Host "DEBUG Info - Read-ConfigFile: ConfigFile does exists!"
Try {
Write-Host "DEBUG Info - Read-ConfigFile: Getting Values from ConfigFile."
Set-Variable -Name ConfigValues -Value (Select-String -Path $ConfigFile -pattern "=" | where {-not($_-match ":[0-9]{1,}:#")}) -Scope Global
} #end try
Catch {
Write-Host "DEBUG Info - Read-ConfigFile: Cannot get Values from ConfigFile."
Write-Host "DEBUG Info - Read-ConfigFile: Unexpected Error!"
Write-Host $Error
EXIT
} #end catch
Finally {
IF (!$ConfigValues) {
Write-Host "DEBUG Info - Read-ConfigFile: Found no valid Values in ConfigFile!"
Write-Host "DEBUG Info - Read-ConfigFile: Unexpected Error!"
Write-Host $Error
EXIT
} #end if
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: Found"$ConfigValues.count"Lines in ConfigFile!."
Write-Host "DEBUG Info - Read-ConfigFile: These are:"
FOREACH ($ConfigValue in $ConfigValues) {
Write-Host "DEBUG Info - Read-ConfigFile: $($ConfigValue)"
}# end foreach
} #end else
} #end finally
} #end if
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: ConfigFile does not exists!"
Write-Host "DEBUG Info - Read-ConfigFile: Unexpected Error!"
Write-Host $Error
EXIT
} #end else
} #end if
#If ConfigFile was read
IF (($ConfigFile) -and ($ConfigValues)) {
Write-Host ""
Write-Host "DEBUG Info - Read-ConfigFile: ConfigFile has been evaluated."
Write-Host "DEBUG Info - Read-ConfigFile: You are looking for: $ConfigLabel."
[Array]$Items = $NULL
[Array]$Items = ($ConfigValues.line | select-string -pattern "$ConfigLabel" | Select-Object -First $ConfigLines)
Write-Host "DEBUG Info - Read-ConfigFile: Line(s) in ConfigFile -> $Items"
#If no Line was found
IF ($($Items.count) -lt 1) {
Write-Host "DEBUG Info - Read-ConfigFile: ($ConfigLabel) seems not to exist in ConfigFile."
Write-Host "DEBUG Info - Read-ConfigFile: FailSafe Setting will be used, if there was one..."
Try {
$Items = (Get-Variable -Name $ConfigLabel -ValueOnly -Scope Global -ErrorAction Stop)
IF ($Items) {
Write-Host "DEBUG Info - Read-ConfigFile: FailSafe returning: $Items"
Return $Items
} #end if
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: FailSafe returning nothing."
Return $NULL
} #end else
} #end try
Catch {
Write-Host "DEBUG Info - Read-ConfigFile: Error reading ConfigValue!"
Write-Host "DEBUG Info - Read-ConfigFile: FailSafe returning nothing."
Return $NULL
} #end catch
} #end if
#If exactly one Line was found
ELSEIF ($($Items.count) -eq 1) {
Write-Host "DEBUG Info - Read-ConfigFile: Found exactly one Line!"
[Array]$Item = $Items
[Array]$Item = ($Item -split "=",2)
[String]$ItemName = $Item[0]
[String]$ItemName = ($ItemName.TrimStart())
[String]$ItemName = ($ItemName.TrimEnd())
[String]$ItemValues = $Item[1]
[String]$ItemValues = ($ItemValues.TrimStart())
[String]$ItemValues = ($ItemValues.TrimEnd())
#If exactly one Line was found, but has no Value inside!
IF (!$ItemValues) {
Write-Host "DEBUG Info - Read-ConfigFile: ($ConfigLabel) seems to exist, but is not configured jet."
Write-Host "DEBUG Info - Read-ConfigFile: FailSafe Setting will be used, if was configured!"
Try {
$ItemValues = (Get-Variable -Name $ConfigLabel -ValueOnly -Scope Global -ErrorAction Stop)
Write-Host "DEBUG Info - Read-ConfigFile: FailSafe returning: $ItemValues"
} #end try
Catch {
Write-Host "DEBUG Info - Read-ConfigFile: Error reading ConfigValue!"
} #end catch
} #end if
#Check again after looking for FailSafe Settings...
IF (!$ItemValues) {
Write-Host "DEBUG Info - Read-ConfigFile: Returning NULL, because nothing was found!"
Return $NULL
} #end if
ELSE {
IF ($ConfigLinesValue -eq "SingleValue") {
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Write-Host "DEBUG Info - Read-ConfigFile: Looking for SingleValue Lines."
Write-Host "DEBUG Info - Read-ConfigFile: Value -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: Returning Datatyp: String"
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Return [String]$ItemValues
} #end if
ELSEIF ($ConfigLinesValue -eq "MultiValue") {
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Write-Host "DEBUG Info - Read-ConfigFile: Looking for MultiValue Lines,"
Write-Host "DEBUG Info - Read-ConfigFile: which are separated by a: $ConfigLinesValueSeparator"
#Prepare Arrays
[Array]$ItemValues = $ItemValues -split "$ConfigLinesValueSeparator"
[System.Collections.ArrayList]$ItemValuesTEMP = @()
#Rebuild the Array, to remove possible Blanks
FOREACH ($ItemValue in $ItemValues) {
IF ($ItemValue) {
#The "| Out-Null" is VERY important, otherwise the Array will be f**ked!
$ItemValue = ($ItemValue.TrimStart())
$ItemValue = ($ItemValue.TrimEnd())
$ItemValuesTEMP.Add("$ItemValue") | Out-null
} #end if
} #end foreach
[Array]$ItemValues = $NULL
[Array]$ItemValues = $ItemValuesTEMP
IF ($($ItemValues.count) -eq 1) {
Write-Host "DEBUG Info - Read-ConfigFile: Found $($ItemValues.count) Array Item!"
Write-Host "DEBUG Info - Read-ConfigFile: Value -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: Returning Datatyp: String"
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Return [String]$ItemValues
} #end if
ELSEIF ($($ItemValues.count) -gt 1) {
Write-Host "DEBUG Info - Read-ConfigFile: Found $($ItemValues.count) Array Items!"
Write-Host "DEBUG Info - Read-ConfigFile: Values -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: Returning Datatyp: Array"
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Return [Array]$ItemValues
} #end elseif
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: Found $($ItemValues.count) Array Item(s)!"
Write-Host "DEBUG Info - Read-ConfigFile: Value(s) -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: Returning Datatyp: $($ItemValues.gettype())"
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Return $ItemValues
} #end else
} #end elseif
} #end else
} #end elseif
#If multiple Lines are found
ELSEIF ($($Items.count) -gt 1) {
Write-Host "DEBUG Info - Read-ConfigFile: Found multiple ($($Items.count)) Lines!"
[Int]$Counter1 = 0
FOREACH ($Item in $Items) {
[Array]$Item = ($Item -split "=",2)
[String]$ItemName = $Item[0]
[String]$ItemName = ($ItemName.TrimStart())
[String]$ItemName = ($ItemName.TrimEnd())
[String]$ItemValues = $Item[1]
[String]$ItemValues = ($ItemValues.TrimStart())
[String]$ItemValues = ($ItemValues.TrimEnd())
IF (($ItemName) -and ($ItemValues)) {
[Int]$Counter1++ | Out-Null
IF ($ConfigLinesValue -eq "SingleValue") {
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Write-Host "DEBUG Info - Read-ConfigFile: Looking for SingleValue Lines."
Write-Host "DEBUG Info - Read-ConfigFile: -> $ItemValues"
} #end if
ELSEIF ($ConfigLinesValue -eq "MultiValue") {
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Write-Host "DEBUG Info - Read-ConfigFile: Looking for MultiValue Lines,"
Write-Host "DEBUG Info - Read-ConfigFile: which are separated by a: $ConfigLinesValueSeparator"
#Rebuild the Array, to remove possible Blanks
[Array]$ItemValues = $ItemValues -split "$ConfigLinesValueSeparator"
[System.Collections.ArrayList]$ItemValuesTEMP = @()
FOREACH ($ItemValue in $ItemValues) {
IF ($ItemValue) {
#The "| Out-Null" is VERY important, otherwise the Array will be f**ked!
$ItemValue = ($ItemValue.TrimStart())
$ItemValue = ($ItemValue.TrimEnd())
$ItemValuesTEMP.Add("$ItemValue") | Out-null
} #end if
} #end foreach
[Array]$ItemValues = $NULL
[Array]$ItemValues = $ItemValuesTEMP
} #end elseif
IF ($($ItemValues.count) -eq 1) {
Write-Host "DEBUG Info - Read-ConfigFile: Found $($ItemValues.count) Array Item!"
Write-Host "DEBUG Info - Read-ConfigFile: Setting Variable: $($ItemName+$Counter1)"
Write-Host "DEBUG Info - Read-ConfigFile: with Value -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: in Datatyp: String"
Set-Variable -Name ($ItemName+$Counter1) -Value ([String]$ItemValues) -Scope Global
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
} #end if
ELSEIF ($($ItemValues.count) -gt 1) {
Write-Host "DEBUG Info - Read-ConfigFile: Found $($ItemValues.count) Array Item(s)!"
Write-Host "DEBUG Info - Read-ConfigFile: Setting Variable: $($ItemName+$Counter1)"
Write-Host "DEBUG Info - Read-ConfigFile: with Value(s) -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: in Datatyp: Array"
Set-Variable -Name ($ItemName+$Counter1) -Value @([Array]$ItemValues) -Scope Global
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
} #end elseif
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: Found $($ItemValues.count) Array Item(s)!"
Write-Host "DEBUG Info - Read-ConfigFile: Setting Variable: $($ItemName+$Counter1)"
Write-Host "DEBUG Info - Read-ConfigFile: with Value(s) -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: in Datatyp: $($ItemValues.gettype() | Select BaseType)"
Set-Variable -Name ($ItemName+$Counter1) -Value $ItemValues -Scope Global
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
} #end else
} #end if
} #end foreach
#Return how many Profiles were are created!
Return [Int]$Counter1
} #end elseif
#That shouldnt be happen...
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: Error reading ConfigValues!"
Write-Host "DEBUG Info - Read-ConfigFile: Exiting, because of this Issue."
Write-Host $Error
EXIT
} #end else
} #end elseif
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: Invalid ConfigValues from ConfigFile!"
Write-Host "DEBUG Info - Read-ConfigFile: Please check the Description of this Function"
Write-Host "DEBUG Info - Read-ConfigFile: and the ConfigFile!"
} #end else
} #end function

View File

@@ -1,452 +0,0 @@
Function Read-ConfigFile {
<#
.SYNOPSIS
Function will read the given ConfigFile, and returns Values or creates Profiles.
.DESCRIPTION
This Function will get Script configurations from a ASCII/ANSI based ConfigFile (INI).
The important criterion is, that every Value the should be read, has to look like this: ConfigLabel = ConfigValue
The ConfigFile should be formated within UTF8 and every Line in a ConfigFile which is beginning with a "#", will be ignored!
By calling this Function the first time, it will read the ConfigFile and save its content into the Variable ConfigFileValues.
In the same call or later calls you can instruct this Function to Return a value for a searched pattern (ConfigLabel).
If nothing was found, Function will try to get a FailSafe Setting (predefined global Variable in Script), if even this fails it will Return $NULL.
Depending on the way your calling this Function, it can return a single Value for a searched ConfigLabel like: $LogPath = E:\Logs,
or it can return multiple Values like; $Domains = .*@my-domain.com;'.*@my-second-domain.com',
or it can create multiple Profiles with single or multiple Values and only returning the Count of the created Profiles.
.REQUIREMENT General
PowerShell V2
.REQUIREMENT Assembly
<NONE>
.REQUIREMENT Variables
ConfigFile, ConfigLabel, ConfigValue, ConfigValues, ConfigLinesValue, ConfigLinesValueSeparator, FileTest, Item, Items, ItemValue, ItemValues, ItemValuesTEMP
.REQUIREMENT Variables preSet
ConfigFile
.REQUIREMENT Functions
<NONE>
.VERSION
Number: 2.0.0.0 / Date: 16.02.2017
.PARAMETER ConfigFile
Give the full path to the ConfigFile (eg. <ScriptName>_Settings.ini). (Default: If you dont give it, Function will try the retrieve ConfigFile (Path and Name) from the Global Variables, set by the calling Script.)
.PARAMETER ConfigLabel
Give the ConfigLabel, you are looking for a Value.
.PARAMETER ConfigLinesValue
Optional Parameter. Select "MultiValue", if in one Line are multiple Values (eg. Array List) separated by "$ConfigLinesValueSeparator". (Default: "SingleValue").
.PARAMETER ConfigLinesValueSeparator
Optional Parameter. Which declares the symbol or character for Value separation (Default: ';').
.PARAMETER ConfigLines
Optional Parameter. Select how many Lines from ConfigFile you expect to get returned. Use Values higher than 1, to work with Profiles. If you do, Function will set Variables and just returns how many are created! (Default: 1).
.PARAMETER Force
Optional Parameter. By using the Force Parameter, ConfigFile will be reloaded.
.EXAMPLE
Set-Variable -Scope Global -Name LogPaths -Value (Read-ConfigFile -ConfigFile "<Path>\<ScriptName>_Settings.ini" -ConfigLabel LogPath) -Force
.EXAMPLE
Set-Variable -Scope Global -Name ListofValues -Value (Read-ConfigFile -ConfigLabel ListofValues -ConfigLinesValue MultiValue) -Force
.EXAMPLE
Set-Variable -Scope Global -Name ProfileCount -Value (Read-ConfigFile -ConfigLabel Profile -ConfigLines 999) -Force
.EXAMPLE
Set-Variable -Scope Global -Name ProfileCount -Value (Read-ConfigFile -ConfigLabel Profile -ConfigLines 999 -ConfigLinesValue MultiValue) -Force
.EXAMPLE
Set-Variable -Scope Global -Name ProfileCount -Value (Read-ConfigFile -ConfigLabel Profile -ConfigLines 999 -ConfigLinesValue MultiValue -ConfigLinesValueSeparator |) -Force
#>
Param (
[Parameter(Position=0,Mandatory=$False,HelpMessage='Give the full path to the ConfigFile (eg. <ScriptName>_Settings.ini). (Default: If you dont give it, Function will try the retrieve ConfigFile (Path and Name) from the Global Variables, set by the calling Script.)')]
[ValidateNotNullOrEmpty()]
[String]$ConfigFile=(Get-Variable -Name ConfigFile -Scope Global -ValueOnly),
[Parameter(Position=1,Mandatory=$True,HelpMessage='Give the ConfigLabel, you are looking for a Value.')]
[ValidateNotNullOrEmpty()]
[String]$ConfigLabel=$NULL,
[Parameter(Position=2,Mandatory=$False,HelpMessage='Optional Parameter. Select "MultiValue", if in one Line are multiple Values (eg. Array List) separated by "$ConfigLinesValueSeparator". (Default: "SingleValue").')]
[ValidateSet("SingleValue","MultiValue")]
[String]$ConfigLinesValue="SingleValue",
[Parameter(Position=3,Mandatory=$False,HelpMessage='Optional Parameter. Which declares the symbol or character for Value separation (Default: ";").')]
[ValidateNotNullOrEmpty()]
[String]$ConfigLinesValueSeparator=';',
[Parameter(Position=4,Mandatory=$False,HelpMessage='Optional Parameter. Select how many Lines from ConfigFile you expect to get returned. Use Values higher than 1, to work with Profiles. If you do, Function will set Variables and just returns how many are created! (Default: 1).')]
[ValidateRange(0,1000)]
[Int]$ConfigLines=1,
[Parameter(Position=5,Mandatory=$False,HelpMessage='Optional Parameter. By using the Force Parameter, ConfigFile will be reloaded.')]
[Switch]$Force
) #end param
#Clear Error Variable
$error.clear()
#If ConfigFile wasnt read, do this at first
IF ((($ConfigFile) -and (!$ConfigValues)) -or ($Force -eq $True)) {
Write-Host ""
Write-Host "DEBUG Info - Read-ConfigFile: ConfigFile has not been evaluated jet..."
Write-Host "DEBUG Info - Read-ConfigFile: Checking for ConfigFile: $ConfigFile"
$FileTest = Test-Path -PathType Leaf $ConfigFile
IF ($FileTest -eq $True) {
Write-Host "DEBUG Info - Read-ConfigFile: ConfigFile does exists!"
Try {
Write-Host "DEBUG Info - Read-ConfigFile: Getting Values from ConfigFile."
Set-Variable -Name ConfigValues -Value (Select-String -Path $ConfigFile -pattern "=" | where {-not($_-match ":[0-9]{1,}:#")}) -Scope Global
} #end try
Catch {
Write-Host "DEBUG Info - Read-ConfigFile: Cannot get Values from ConfigFile."
Write-Host "DEBUG Info - Read-ConfigFile: Unexpected Error!"
Write-Host $Error
EXIT
} #end catch
Finally {
IF (!$ConfigValues) {
Write-Host "DEBUG Info - Read-ConfigFile: Found no valid Values in ConfigFile!"
Write-Host "DEBUG Info - Read-ConfigFile: Unexpected Error!"
Write-Host $Error
EXIT
} #end if
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: Found"$ConfigValues.count"Lines in ConfigFile!."
Write-Host "DEBUG Info - Read-ConfigFile: These are:"
FOREACH ($ConfigValue in $ConfigValues) {
Write-Host "DEBUG Info - Read-ConfigFile: $($ConfigValue)"
}# end foreach
} #end else
} #end finally
} #end if
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: ConfigFile does not exists!"
Write-Host "DEBUG Info - Read-ConfigFile: Unexpected Error!"
Write-Host $Error
EXIT
} #end else
} #end if
#If ConfigFile was read
IF (($ConfigFile) -and ($ConfigValues)) {
Write-Host ""
Write-Host "DEBUG Info - Read-ConfigFile: ConfigFile has been evaluated."
Write-Host "DEBUG Info - Read-ConfigFile: You are looking for: $ConfigLabel."
[Array]$Items = $NULL
[Array]$Items = ($ConfigValues.line | select-string -pattern "$ConfigLabel" | Select-Object -First $ConfigLines)
Write-Host "DEBUG Info - Read-ConfigFile: Line(s) in ConfigFile -> $Items"
#If no Line was found
IF ($($Items.count) -lt 1) {
Write-Host "DEBUG Info - Read-ConfigFile: ($ConfigLabel) seems not to exist in ConfigFile."
Write-Host "DEBUG Info - Read-ConfigFile: FailSafe Setting will be used, if there was one..."
Try {
$Items = (Get-Variable -Name $ConfigLabel -ValueOnly -Scope Global -ErrorAction Stop)
IF ($Items) {
Write-Host "DEBUG Info - Read-ConfigFile: FailSafe returning: $Items"
Return $Items
} #end if
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: FailSafe returning nothing."
Return $NULL
} #end else
} #end try
Catch {
Write-Host "DEBUG Info - Read-ConfigFile: Error reading ConfigValue!"
Write-Host "DEBUG Info - Read-ConfigFile: FailSafe returning nothing."
Return $NULL
} #end catch
} #end if
#If exactly one Line was found
ELSEIF ($($Items.count) -eq 1) {
Write-Host "DEBUG Info - Read-ConfigFile: Found exactly one Line!"
[Array]$Item = $Items
[Array]$Item = ($Item -split "=",2)
[String]$ItemName = $Item[0]
[String]$ItemName = ($ItemName.TrimStart())
[String]$ItemName = ($ItemName.TrimEnd())
[String]$ItemValues = $Item[1]
[String]$ItemValues = ($ItemValues.TrimStart())
[String]$ItemValues = ($ItemValues.TrimEnd())
#If exactly one Line was found, but has no Value inside!
IF (!$ItemValues) {
Write-Host "DEBUG Info - Read-ConfigFile: ($ConfigLabel) seems to exist, but is not configured jet."
Write-Host "DEBUG Info - Read-ConfigFile: FailSafe Setting will be used, if was configured!"
Try {
$ItemValues = (Get-Variable -Name $ConfigLabel -ValueOnly -Scope Global -ErrorAction Stop)
Write-Host "DEBUG Info - Read-ConfigFile: FailSafe returning: $ItemValues"
} #end try
Catch {
Write-Host "DEBUG Info - Read-ConfigFile: Error reading ConfigValue!"
} #end catch
} #end if
#Check again after looking for FailSafe Settings...
IF (!$ItemValues) {
Write-Host "DEBUG Info - Read-ConfigFile: Returning NULL, because nothing was found!"
Return $NULL
} #end if
ELSE {
IF ($ConfigLinesValue -eq "SingleValue") {
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Write-Host "DEBUG Info - Read-ConfigFile: Looking for SingleValue Lines."
Write-Host "DEBUG Info - Read-ConfigFile: Value -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: Returning Datatyp: String"
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Return [String]$ItemValues
} #end if
ELSEIF ($ConfigLinesValue -eq "MultiValue") {
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Write-Host "DEBUG Info - Read-ConfigFile: Looking for MultiValue Lines,"
Write-Host "DEBUG Info - Read-ConfigFile: which are separated by a: $ConfigLinesValueSeparator"
#Prepare Arrays
[Array]$ItemValues = $ItemValues -split "$ConfigLinesValueSeparator"
[System.Collections.ArrayList]$ItemValuesTEMP = @()
#Rebuild the Array, to remove possible Blanks
FOREACH ($ItemValue in $ItemValues) {
IF ($ItemValue) {
#The "| Out-Null" is VERY important, otherwise the Array will be f**ked!
$ItemValue = ($ItemValue.TrimStart())
$ItemValue = ($ItemValue.TrimEnd())
$ItemValuesTEMP.Add("$ItemValue") | Out-null
} #end if
} #end foreach
[Array]$ItemValues = $NULL
[Array]$ItemValues = $ItemValuesTEMP
IF ($($ItemValues.count) -eq 1) {
Write-Host "DEBUG Info - Read-ConfigFile: Found $($ItemValues.count) Array Item!"
Write-Host "DEBUG Info - Read-ConfigFile: Value -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: Returning Datatyp: String"
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Return [String]$ItemValues
} #end if
ELSEIF ($($ItemValues.count) -gt 1) {
Write-Host "DEBUG Info - Read-ConfigFile: Found $($ItemValues.count) Array Items!"
Write-Host "DEBUG Info - Read-ConfigFile: Values -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: Returning Datatyp: Array"
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Return [Array]$ItemValues
} #end elseif
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: Found $($ItemValues.count) Array Item(s)!"
Write-Host "DEBUG Info - Read-ConfigFile: Value(s) -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: Returning Datatyp: $($ItemValues.gettype())"
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Return $ItemValues
} #end else
} #end elseif
} #end else
} #end elseif
#If multiple Lines are found
ELSEIF ($($Items.count) -gt 1) {
Write-Host "DEBUG Info - Read-ConfigFile: Found multiple ($($Items.count)) Lines!"
[Int]$Counter1 = 0
FOREACH ($Item in $Items) {
[Array]$Item = ($Item -split "=",2)
[String]$ItemName = $Item[0]
[String]$ItemName = ($ItemName.TrimStart())
[String]$ItemName = ($ItemName.TrimEnd())
[String]$ItemValues = $Item[1]
[String]$ItemValues = ($ItemValues.TrimStart())
[String]$ItemValues = ($ItemValues.TrimEnd())
IF (($ItemName) -and ($ItemValues)) {
[Int]$Counter1++ | Out-Null
IF ($ConfigLinesValue -eq "SingleValue") {
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Write-Host "DEBUG Info - Read-ConfigFile: Looking for SingleValue Lines."
Write-Host "DEBUG Info - Read-ConfigFile: -> $ItemValues"
} #end if
ELSEIF ($ConfigLinesValue -eq "MultiValue") {
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Write-Host "DEBUG Info - Read-ConfigFile: Looking for MultiValue Lines,"
Write-Host "DEBUG Info - Read-ConfigFile: which are separated by a: $ConfigLinesValueSeparator"
#Rebuild the Array, to remove possible Blanks
[Array]$ItemValues = $ItemValues -split "$ConfigLinesValueSeparator"
[System.Collections.ArrayList]$ItemValuesTEMP = @()
FOREACH ($ItemValue in $ItemValues) {
IF ($ItemValue) {
#The "| Out-Null" is VERY important, otherwise the Array will be f**ked!
$ItemValue = ($ItemValue.TrimStart())
$ItemValue = ($ItemValue.TrimEnd())
$ItemValuesTEMP.Add("$ItemValue") | Out-null
} #end if
} #end foreach
[Array]$ItemValues = $NULL
[Array]$ItemValues = $ItemValuesTEMP
} #end elseif
IF ($($ItemValues.count) -eq 1) {
#IF (($($ItemValues.count) -eq 1) -ne ($ConfigLinesValue -eq "MultiValue")) {
Write-Host "DEBUG Info - Read-ConfigFile: Found $($ItemValues.count) Array Item!"
Write-Host "DEBUG Info - Read-ConfigFile: Setting Variable: $($ItemName+$Counter1)"
Write-Host "DEBUG Info - Read-ConfigFile: with Value -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: in Datatyp: String"
Set-Variable -Name ($ItemName+$Counter1) -Value ([String]$ItemValues) -Scope Global
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
} #end if
ELSEIF (($($ItemValues.count) -gt 1) -or ($ConfigLinesValue -eq "MultiValue")) {
Write-Host "DEBUG Info - Read-ConfigFile: Found $($ItemValues.count) Array Item(s)!"
Write-Host "DEBUG Info - Read-ConfigFile: Setting Variable: $($ItemName+$Counter1)"
Write-Host "DEBUG Info - Read-ConfigFile: with Value(s) -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: in Datatyp: Array"
Set-Variable -Name ($ItemName+$Counter1) -Value @([Array]$ItemValues) -Scope Global
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
} #end elseif
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: Found $($ItemValues.count) Array Item(s)!"
Write-Host "DEBUG Info - Read-ConfigFile: Setting Variable: $($ItemName+$Counter1)"
Write-Host "DEBUG Info - Read-ConfigFile: with Value(s) -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: in Datatyp: $($ItemValues.gettype() | Select BaseType)"
Set-Variable -Name ($ItemName+$Counter1) -Value $ItemValues -Scope Global
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
} #end else
} #end if
} #end foreach
#Return how many Profiles were are created!
Return [Int]$Counter1
} #end elseif
#That shouldnt be happen...
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: Error reading ConfigValues!"
Write-Host "DEBUG Info - Read-ConfigFile: Exiting, because of this Issue."
Write-Host $Error
EXIT
} #end else
} #end elseif
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: Invalid ConfigValues from ConfigFile!"
Write-Host "DEBUG Info - Read-ConfigFile: Please check the Description of this Function"
Write-Host "DEBUG Info - Read-ConfigFile: and the ConfigFile!"
} #end else
} #end function

View File

@@ -1,117 +0,0 @@
Function Remove-Item-withLogging {
<#
.SYNOPSIS
Function will delete Items selected by Path, Name and Age.
.DESCRIPTION
Function will delete Items selected by Path, Name and Age, with logging this.
For a successful performed deletion, Function will Return $True, for unccessful $False.
.REQUIREMENT General
PowerShell V2
.REQUIREMENT Variables
Path, FileKeepTime, FileBaseName, Item, Items
.REQUIREMENT Assembly
<NONE>
.REQUIREMENT Functions
Write-LogFile
.VERSION
Number: 1.1.0.0 / Date: 21.11.2016
.PARAMETER Path
Give the Full Path, where the Item(s) located, which should be deleted.
.PARAMETER FileKeepTime
Give the time in Days, which Items should be deleted, which are older than...
.PARAMETER FileBaseName
Give the <Filename> an which will be selected, the Item(s) to delete. Given <Filename> will be set with Wildcards: *<Filename>*.
.EXAMPLE
Remove-Item-withLogging -Path "E:\LogFiles" -FileKeepTime 5 -FileBaseName Filename
#>
[cmdletbinding()]
Param (
[Parameter(Mandatory=$True,HelpMessage='Give the Full Path, where the Item(s) located, which should be deleted.')]
[ValidateNotNullOrEmpty()]
[String]$Path=$NULL,
[Parameter(Mandatory=$True,HelpMessage='Give the time in Days, which Item(s) should be deleted, which are older than...')]
[ValidateRange(0,1000)]
[Int]$FileKeepTime=$NULL,
[Parameter(Mandatory=$True,HelpMessage='Give the Filename an which will be selected, the Item(s) to delete. Given <Filename> will be set with Wildcards: *<Filename>*.')]
[ValidateNotNullOrEmpty()]
[String]$FileBaseName=$NULL
) #end param
#Checking if "Write-LogFile" Module was loaded
IF (Get-Module -Name "Write-LogFile") {
IF ($FileKeepTime -gt 0) {
Write-Logfile -LogLine "Files should be removed which are older than $FileKeepTime Day(s)."
$Items = (Get-ChildItem -Path "$Path\*" -Filter *.log | where {$_.Name -like "*$FileBaseName*" -and $_.lastwritetime -lt $((Get-Date).AddDays(-$FileKeepTime)) -and -not $_.psiscontainer})
IF ($Items -eq $null) {
Write-Logfile -LogLine "Found no old Files."
Return $False
} #end if
ELSE {
Write-Logfile -LogLine "Deleting old Files (Found: $($Items.count)) :"
FOREACH ($Item in $Items) {
Try {
Remove-Item -Path $Item -Force -Verbose -ErrorVariable Error -ErrorAction Continue
Write-Logfile -LogLine "LogFile: $Item was removed."
Return $True
} #end try
Catch {
Write-Logfile -LogLine "File: $Item cannot been removed."
Write-Logfile -LogLine "Please check your privileges!"
} #end catch
} #end foreach
} #end else
} #end if
ELSE {
Write-Logfile -LogLine "You disabled File deleting, they all will be kept."
Return $False
} #end else
} #end if
ELSE {
Write-Host ""
Write-Host "DEBUG Info: Write-LogFile - Module does not exist!"
Write-Host "DEBUG Info: Please load the Module and try again, running this Function/Module!"
Write-Host "DEBUG Info: Exiting, because of this Issue."
EXIT
} #end else
} #end function

View File

@@ -1,363 +0,0 @@
Function Restart-windreamClient-withLogging {
<#
.SYNOPSIS
Restart windream Client Components via COM Interface
.DESCRIPTION
If Connection to the windream Server gets interrupted (network loss, eg.), it is neccessery to restart the Client Components.
Otherwise you can Stop or Start Client Components with this Function.
For a successful performed Action, Function will Return $True, for unccessful $False.
.REQUIREMENT General
PowerShell V3, windream Client Connectivity (>=V3.6)
.REQUIREMENT Assembly
<NONE>
.REQUIREMENT Variables
windreamControlCenter, windreamIndexService, ServiceTest, Action
.REQUIREMENT Variables preSet
<NONE>
.REQUIREMENT Functions
Write-LogFile
.VERSION
1.1.0.0 / 21.11.2016
.PARAMETER Action
Determine which Action you want to perform <Stop|Restart|Start>. Default Value is <Restart>.
.PARAMETER ServiceTest
Set on $True, if Function should check for a running windream vfs Client Service. If it is and Service is stopped, Function will try to start Service. Default Value is $True.
.EXAMPLE
Restart-windreamClient
.EXAMPLE
Restart-windreamClient -Action Start
.EXAMPLE
Restart-windreamClient -Action Start -ServiceTest $False
#>
[cmdletbinding()]
Param (
[Parameter(mandatory=$False,HelpMessage='Determine which Action you want to perform <Stop|Restart|Start>. Default Value is "Restart".')]
[ValidateSet("Stop","Restart","Start")]
[String]$Action="Restart",
[Parameter(mandatory=$False,HelpMessage='Set on $True, if Function should check for a running windream vfs Client Service. If it is and Service is stopped, Function will try to start Service. Default Value is $True.')]
[ValidateSet($True,$False)]
[Switch]$ServiceTest=$True
) #end param
#Clear Error Variable
$error.clear()
#Checking if "Write-LogFile" Module was loaded
IF (Get-Module -Name "Write-LogFile") {
Write-Host "DEBUG Info: Write-LogFile - Module exists."
#If Servie Test was enabled (by default true) check if windream vfs Service is running
IF ($ServiceTest -eq $True) {
Write-LogFile -LogLine " "
Write-LogFile -LogLine "Service Test is enabled!"
#Check if windream vfs Service is installed
Try {
[Object]$ServiceTest = $NULL
[Object]$ServiceTest = Get-Service -Name vfssvc -ErrorAction Stop
Write-LogFile -LogLine "Found Service: vfssvc"
Write-LogFile -LogLine "Service is currently: $((Get-Service -Name vfssvc).Status)"
} #end try
Catch {
Write-LogFile -LogLine "WARNING: windream Client seems not to be installed completely."
Write-LogFile -LogLine "Missing Service: vfssvc"
} #end catch
} #end if
#If Servie Test is disabled
ELSE {
Write-LogFile -LogLine " "
Write-LogFile -LogLine "Service Test is disabled!"
} #end else
#Try to create windream Objects
Try {
[Object]$windreamControlCenter = New-Object -ComObject "Wmcc.ControlCenter" -ErrorAction Stop
[Object]$windreamIndexService = New-Object -ComObject "WMIndexServer.WMIdxSvControl" -ErrorAction Stop
} #end try
Catch {
Write-Logfile -LogLine "Cannot create Object from windream Class Wmcc.ControlCenter or WMIndexServer.WMIdxSvControl!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
#If Function was called to Stop windream Client Components
IF ($Action -like "Stop") {
Write-LogFile -LogLine "Stop windream Client Components."
#Try to stop windream Client Components
Try {
Write-Logfile -LogLine "Stopping windream Client Components!"
$windreamControlCenter.StartVFSService(0) | Out-Null
$windreamIndexService.Shutdown() | Out-Null
$windreamControlCenter.ExitCC(0) | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot stop windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Return $True
} #end if
#If Function was called to Restart windream Client Components and Service Test was enabled
ELSEIF (($Action -like "Restart") -and ($ServiceTest -is [Object])) {
#Checking if windream vfs Service is running
IF ((Get-Service -Name vfssvc).Status -ne 'running') {
Write-LogFile -LogLine "Warning: windream vfs Service is not running!"
Try {
Write-Logfile -LogLine "Trying to Start/Restart the windream vfs Service!"
Stop-Service -Name vfssvc -ErrorAction SilentlyContinue
Start-Service -Name vfssvc -ErrorAction Stop
} #end try
Catch {
Write-Logfile -LogLine "Cannot Start/Restart windream vfs Service!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
} #end if
ELSE {
Write-Logfile -LogLine " "
Write-LogFile -LogLine "windream vfs Service is running!"
} #end else
Write-LogFile -LogLine "Restart windream Client Components."
#Try to stop windream Client Components
Try {
Write-Logfile -LogLine "Stopping windream Client Components!"
$windreamControlCenter.StartVFSService(0) | Out-Null
$windreamIndexService.Shutdown() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot stop windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
#Try to start windream Client Components
Try {
Write-Logfile -LogLine "Starting windream Client Components!"
$windreamControlCenter.StartVFSService(1) | Out-Null
$windreamIndexService.Start() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot start windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Return $True
} #end elseif
#If Function was called to Restart windream Client Components and Service Test was disabled
ELSEIF (($Action -like "Restart") -and ($ServiceTest -is [Switch])) {
Write-LogFile -LogLine "Restart windream Client Components."
#Try to stop windream Client Components
Try {
Write-Logfile -LogLine "Stopping windream Client Components!"
$windreamControlCenter.StartVFSService(0) | Out-Null
$windreamIndexService.Shutdown() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot stop windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
#Try to start windream Client Components
Try {
Write-Logfile -LogLine "Starting windream Client Components!"
$windreamControlCenter.StartVFSService(1) | Out-Null
$windreamIndexService.Start() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot start windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Return $True
} #end elseif
#If Function was called to Start windream Client Components and Service Test was enabled
ELSEIF (($Action -like "Start") -and ($ServiceTest -is [Object])) {
#Checking if windream vfs Service is running
IF ((Get-Service -Name vfssvc).Status -ne 'running') {
Write-LogFile -LogLine "Warning: windream vfs Service is not running!"
Try {
Write-Logfile -LogLine "Trying to Start/Restart the windream vfs Service!"
Stop-Service -Name vfssvc -ErrorAction SilentlyContinue
Start-Service -Name vfssvc -ErrorAction Stop
} #end try
Catch {
Write-Logfile -LogLine "Cannot Start/Restart windream vfs Service!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
} #end if
ELSE {
Write-Logfile -LogLine " "
Write-LogFile -LogLine "windream vfs Service is running!"
} #end else
Write-LogFile -LogLine "Start windream Client Components."
#Try to start windream Client Components
Try {
Write-Logfile -LogLine "Starting windream Client Components!"
$windreamControlCenter.StartVFSService(1) | Out-Null
$windreamIndexService.Start() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot start windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Return $True
} #end elseif
#If Function was called to Start windream Client Components and Service Test was disabled
ELSEIF (($Action -like "Start") -and ($ServiceTest -is [Switch])) {
Write-LogFile -LogLine "Start windream Client Components."
#Try to start windream Client Components
Try {
Write-Logfile -LogLine "Starting windream Client Components!"
$windreamControlCenter.StartVFSService(1) | Out-Null
$windreamIndexService.Start() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot start windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Return $True
} #end elseif
#If Function was called invalid Values, which should be not possible be the ValidateSet of the Function Parameters
ELSE {
Write-Logfile -LogLine "Function Call went wrong, please check the ValidateSet"
Write-Logfile -LogLine $Error
Return $False
} #end else
} #end if
ELSE {
Write-Host ""
Write-Host "DEBUG Info: Write-LogFile - Module does not exist!"
Write-Host "DEBUG Info: Please load the Module and try again, running this Function/Module!"
Write-Host "DEBUG Info: Exiting, because of this Issue."
EXIT
} #end else
} #end function

View File

@@ -1,361 +0,0 @@
Function Restart-windreamClient-withLogging {
<#
.SYNOPSIS
Restart windream Client Components via COM Interface
.DESCRIPTION
If Connection to the windream Server gets interrupted (network loss, eg.), it is neccessery to restart the Client Components.
Otherwise you can Stop or Start Client Components with this Function.
For a successful performed Action, Function will Return $True, for unccessful $False.
.REQUIREMENT General
PowerShell V3, windream Client Connectivity (>=V3.6)
.REQUIREMENT Assembly
<NONE>
.REQUIREMENT Variables
windreamControlCenter, windreamIndexService, ServiceTest, Action
.REQUIREMENT Variables preSet
<NONE>
.REQUIREMENT Functions
Write-LogFile
.VERSION
1.1.0.1 / 22.11.2016
.PARAMETER Action
Determine which Action you want to perform <Stop|Restart|Start>. Default Value is <Restart>.
.PARAMETER ServiceTest
Set on $True, if Function should check for a running windream vfs Client Service. If it is and Service is stopped, Function will try to start Service. Default Value is $True.
.EXAMPLE
Restart-windreamClient
.EXAMPLE
Restart-windreamClient -Action Start
.EXAMPLE
Restart-windreamClient -Action Start -ServiceTest $False
#>
Param (
[Parameter(Mandatory=$False,HelpMessage='Determine which Action you want to perform <Stop|Restart|Start>. Default Value is "Restart".')]
[ValidateSet("Stop","Restart","Start")]
[String]$Action="Restart",
[Parameter(Mandatory=$False,HelpMessage='Set on $True, if Function should check for a running windream vfs Client Service. If it is and Service is stopped, Function will try to start Service. Default Value is $True.')]
[ValidateSet($True,$False)]
[Switch]$ServiceTest=$True
) #end param
#Clear Error Variable
$error.clear()
#Checking if "Write-LogFile" Module was loaded
IF (Get-Module -Name "Write-LogFile") {
Write-Host "DEBUG Info: Write-LogFile - Module exists."
#If Servie Test was enabled (by default true) check if windream vfs Service is running
IF ($ServiceTest -eq $True) {
Write-LogFile -LogLine " "
Write-LogFile -LogLine "Service Test is enabled!"
#Check if windream vfs Service is installed
Try {
[Object]$ServiceTest = $NULL
[Object]$ServiceTest = Get-Service -Name vfssvc -ErrorAction Stop
Write-LogFile -LogLine "Found Service: vfssvc"
Write-LogFile -LogLine "Service is currently: $((Get-Service -Name vfssvc).Status)"
} #end try
Catch {
Write-LogFile -LogLine "WARNING: windream Client seems not to be installed completely."
Write-LogFile -LogLine "Missing Service: vfssvc"
} #end catch
} #end if
#If Servie Test is disabled
ELSE {
Write-LogFile -LogLine " "
Write-LogFile -LogLine "Service Test is disabled!"
} #end else
#Try to create windream Objects
Try {
[Object]$windreamControlCenter = New-Object -ComObject "Wmcc.ControlCenter" -ErrorAction Stop
[Object]$windreamIndexService = New-Object -ComObject "WMIndexServer.WMIdxSvControl" -ErrorAction Stop
} #end try
Catch {
Write-Logfile -LogLine "Cannot create Object from windream Class Wmcc.ControlCenter or WMIndexServer.WMIdxSvControl!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
#If Function was called to Stop windream Client Components
IF ($Action -like "Stop") {
Write-LogFile -LogLine "Stop windream Client Components."
#Try to stop windream Client Components
Try {
Write-Logfile -LogLine "Stopping windream Client Components!"
$windreamControlCenter.StartVFSService(0) | Out-Null
$windreamIndexService.Shutdown() | Out-Null
$windreamControlCenter.ExitCC(0) | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot stop windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Return $True
} #end if
#If Function was called to Restart windream Client Components and Service Test was enabled
ELSEIF (($Action -like "Restart") -and ($ServiceTest -is [Object])) {
#Checking if windream vfs Service is running
IF ((Get-Service -Name vfssvc).Status -ne 'running') {
Write-LogFile -LogLine "Warning: windream vfs Service is not running!"
Try {
Write-Logfile -LogLine "Trying to Start/Restart the windream vfs Service!"
Stop-Service -Name vfssvc -ErrorAction SilentlyContinue
Start-Service -Name vfssvc -ErrorAction Stop
} #end try
Catch {
Write-Logfile -LogLine "Cannot Start/Restart windream vfs Service!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
} #end if
ELSE {
Write-Logfile -LogLine " "
Write-LogFile -LogLine "windream vfs Service is running!"
} #end else
Write-LogFile -LogLine "Restart windream Client Components."
#Try to stop windream Client Components
Try {
Write-Logfile -LogLine "Stopping windream Client Components!"
$windreamControlCenter.StartVFSService(0) | Out-Null
$windreamIndexService.Shutdown() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot stop windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
#Try to start windream Client Components
Try {
Write-Logfile -LogLine "Starting windream Client Components!"
$windreamControlCenter.StartVFSService(1) | Out-Null
$windreamIndexService.Start() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot start windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Return $True
} #end elseif
#If Function was called to Restart windream Client Components and Service Test was disabled
ELSEIF (($Action -like "Restart") -and ($ServiceTest -is [Switch])) {
Write-LogFile -LogLine "Restart windream Client Components."
#Try to stop windream Client Components
Try {
Write-Logfile -LogLine "Stopping windream Client Components!"
$windreamControlCenter.StartVFSService(0) | Out-Null
$windreamIndexService.Shutdown() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot stop windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
#Try to start windream Client Components
Try {
Write-Logfile -LogLine "Starting windream Client Components!"
$windreamControlCenter.StartVFSService(1) | Out-Null
$windreamIndexService.Start() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot start windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Return $True
} #end elseif
#If Function was called to Start windream Client Components and Service Test was enabled
ELSEIF (($Action -like "Start") -and ($ServiceTest -is [Object])) {
#Checking if windream vfs Service is running
IF ((Get-Service -Name vfssvc).Status -ne 'running') {
Write-LogFile -LogLine "Warning: windream vfs Service is not running!"
Try {
Write-Logfile -LogLine "Trying to Start/Restart the windream vfs Service!"
Stop-Service -Name vfssvc -ErrorAction SilentlyContinue
Start-Service -Name vfssvc -ErrorAction Stop
} #end try
Catch {
Write-Logfile -LogLine "Cannot Start/Restart windream vfs Service!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
} #end if
ELSE {
Write-Logfile -LogLine " "
Write-LogFile -LogLine "windream vfs Service is running!"
} #end else
Write-LogFile -LogLine "Start windream Client Components."
#Try to start windream Client Components
Try {
Write-Logfile -LogLine "Starting windream Client Components!"
$windreamControlCenter.StartVFSService(1) | Out-Null
$windreamIndexService.Start() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot start windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Return $True
} #end elseif
#If Function was called to Start windream Client Components and Service Test was disabled
ELSEIF (($Action -like "Start") -and ($ServiceTest -is [Switch])) {
Write-LogFile -LogLine "Start windream Client Components."
#Try to start windream Client Components
Try {
Write-Logfile -LogLine "Starting windream Client Components!"
$windreamControlCenter.StartVFSService(1) | Out-Null
$windreamIndexService.Start() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot start windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Return $True
} #end elseif
#If Function was called invalid Values, which should be not possible be the ValidateSet of the Function Parameters
ELSE {
Write-Logfile -LogLine "Function Call went wrong, please check the ValidateSet"
Write-Logfile -LogLine $Error
Return $False
} #end else
} #end if
ELSE {
Write-Host ""
Write-Host "DEBUG Info: Write-LogFile - Module does not exist!"
Write-Host "DEBUG Info: Please load the Module and try again, running this Function/Module!"
Write-Host "DEBUG Info: Exiting, because of this Issue."
EXIT
} #end else
} #end function

View File

@@ -1,304 +0,0 @@
Function Start-windreamSession-withLogging {
<#
.SYNOPSIS
Start a connection / Session with a windream Server.
.DESCRIPTION
To work in or with windream, you need to start a Session with a windream Server, to access its files, folders and indices.
The windream Drive letter which was retrived by running this module, will be set for the whole Script.
For Impersonation Login Methode, all these Parameters must be set: windreamServer, windreamDomain, windreamUserName and windreamUserPassword.
Function returns with the whole windreamSession Object if connection was successfully established, otherwise with a $False.
.REQUIREMENT General
PowerShell V3, windream Client Connectivity (>=V3.6)
.REQUIREMENT Assembly
<NONE>
.REQUIREMENT Variables
windreamServer, windreamVersion, windreamServerBrowser, windreamConnect, windreamSession
.REQUIREMENT Variables preSet
<NONE>
.REQUIREMENT Functions
Write-LogFile
.VERSION
1.1.0.0 / 21.11.2016
.PARAMETER windreamServer
Optional Parameter. Give Server Name of a specific windream Server, you want to connect with. Otherwise default will be choosen.
.PARAMETER windreamDomain
Optional Parameter. Give a Windows Domain (which is windream autorisiered) for Impersonation Login Methode. Otherwise current domain will be choosen.
.PARAMETER windreamUserName
Optional Parameter. Give a Windows User Name (who is windream autorisiered) for Impersonation Login Methode. Otherwise current User Name will be choosen.
.PARAMETER windreamUserPassword
Optional Parameter. Give the Password for the User name you set bevor in $windreamUserName for Impersonation Login Methode.
.PARAMETER windreamVersion
Optional Parameter. Give the minimum Version of windream, to make sure later function calls will work (Example 3.6, 4.0, ...).
.PARAMETER windream64Bit
Optional Parameter. Available since windream 6.0. Necessary, if following functions need 64Bit Integer Support (eg. GetWMObjectByIdEx64(WMEntity aWMEntity, int64 aWMObjectId)).
.EXAMPLE
Start-windreamSession
.EXAMPLE
Start-windreamSession -windreamVersion "3.6" -windream64Bit <$True|$False>
.EXAMPLE
Start-windreamSession -windreamServer <ServerName> -windreamDomain <domain.local> -windreamUserName <UserName> -windreamUserPassword <UserPassword>
.EXAMPLE
Start-windreamSession -windreamVersion "3.6" -windream64Bit <$True|$False> -windreamServer <ServerName> -windreamDomain <domain.local> -windreamUserName <UserName> -windreamUserPassword <UserPassword>
#>
[cmdletbinding()]
Param (
[Parameter(mandatory=$False,HelpMessage='Optional Parameter. Give Server Name of a specific windream Server, you want to connect with. Otherwise default will be choosen.')]
[AllowEmptyString()]
[String]$windreamServer=$NULL,
[Parameter(mandatory=$False,HelpMessage='Optional Parameter. Give a Windows Domain (which is windream autorisiered) for Impersonation Login Methode. Otherwise current domain will be choosen.')]
[ValidateNotNullOrEmpty()]
[String]$windreamDomain=$NULL,
[Parameter(mandatory=$False,HelpMessage='Optional Parameter. Give a Windows User Name (who is windream autorisiered) for Impersonation Login Methode. Otherwise current User Name will be choosen.')]
[ValidateNotNullOrEmpty()]
[String]$windreamUserName=$NULL,
[Parameter(mandatory=$False,HelpMessage='Optional Parameter. Give the Password for the User name you set bevor in $windreamUserName for Impersonation Login Methode.')]
[ValidateNotNullOrEmpty()]
[String]$windreamUserPassword=$NULL,
[Parameter(mandatory=$False,HelpMessage='Optional Parameter. Give the minimum Version of windream, to make sure later function calls will work (Example 3.6, 4.0, ...). Default Value is 4.0.')]
[ValidateNotNullOrEmpty()]
[String]$windreamVersion="4.0",
[Parameter(mandatory=$False,HelpMessage='Optional Parameter. Available since windream 6.0. Necessary, if following functions need 64Bit Integer Support (eg. GetWMObjectByIdEx64(WMEntity aWMEntity, int64 aWMObjectId)). Default Value is $False')]
[ValidateSet($True,$False)]
[Switch]$windream64Bit=$False
) #end param
#Clear Error Variable
$error.clear()
#Checking if "Write-LogFile" Module was loaded
IF (Get-Module -Name "Write-LogFile") {
Write-Host "DEBUG Info: Write-LogFile - Module exists."
#If Function was called without an explicite windream Server, try to get the default
IF (!$windreamServer) {
Write-Logfile -LogLine " "
Write-Logfile -LogLine "Function was called without a specific windream Server,"
Write-Logfile -LogLine "trying to find the default windream Server."
Try {
$windreamServerBrowser = New-Object -ComObject "WMOBrws.ServerBrowser" -ErrorAction Stop
$windreamServer = $windreamServerBrowser.GetCurrentServer()
Write-Logfile -LogLine "windream Server is: $windreamServer"
} #end try
Catch {
Write-Logfile -LogLine "Cannot create Object from windream Class WMOBrws.ServerBrowser!"
Write-Logfile -LogLine "And/Or unable the retrieve default windream Server!"
$windreamServer = $NULL
} #end catch
} #end if
#If Function was called with an explicite windream Server
ELSE {
Write-Logfile -LogLine " "
Write-Logfile -LogLine "Function was called with specific windream Server, trying to connect to $windreamServer"
Write-Logfile -LogLine "Remember: Since windream 4.0, this will only work if you are using Impersonation Login Methode."
Write-LogFile -Logline "windreamServer, windreamDomain, windreamUserName and windreamUserPassword"
Try {
$windreamServerBrowser = New-Object -ComObject "WMOBrws.ServerBrowser" -ErrorAction Stop
} #end try
Catch {
Write-Logfile -LogLine "Cannot create Object from windream Class WMOBrws.ServerBrowser!"
Return $False
} #end catch
} #end else
#Go ahead if windreamServer is not null and is reachable via network ping
IF (($windreamServer) -and (Test-Connection -ComputerName $windreamServer -Count 1 -ErrorAction SilentlyContinue)) {
Try {
$windreamConnect = New-Object -ComObject "Windream.WMConnect" -ErrorAction Stop
$windreamConnect.MinReqVersion = $windreamVersion
$windreamConnect.ClientSupports64BitID = $windream64Bit
Write-Logfile -LogLine "windream Connect created!"
} # end try
Catch {
Write-Logfile -LogLine "Cannot create Object from windream Class Windream.WMSession!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Try {
$windreamSession = New-Object -ComObject "Windream.WMSession" #-ErrorAction Stop
Write-Logfile -LogLine "windream Session created!"
} #end try
Catch {
Write-Logfile -LogLine "Cannot create Object from windream Class Windream.WMSession!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
#Use Impersonation Login methode, if these three Parameters are set (-gt $NULL).
IF (($windreamUserName) -and ($windreamUserPassword) -and ($windreamDomain)) {
Try {
$windreamConnect.ModuleId = 9
$windreamImpersonation = New-Object -ComObject "WMOTool.WMUserIdentity" -ErrorAction Stop
$windreamImpersonation.aDomain = $windreamDomain
$windreamImpersonation.aPassword = $windreamUserPassword
$windreamImpersonation.aServerName = $windreamServer
$windreamImpersonation.aUserName = $windreamUserName
Try {
Write-Logfile -LogLine "Try to Login Impersonation"
$windreamSession = $windreamConnect.Login($windreamImpersonation)
} #end try
Catch {
Write-Logfile -LogLine "Cannot Login into windream Session!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
} #end try
Catch {
Write-Logfile -LogLine "Cannot create Object from windream Class WMOTool.WMUserIdentity!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
} #end if
#If Impersonation Login methode was not set, try to login with current username, domain and password
ELSE {
Try {
Write-Logfile -LogLine "Try to Login with current credentials."
$windreamConnect.LoginSession($windreamSession)
} #end try
Catch {
Write-Logfile -LogLine "Cannot Login into windream Session!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
} #end else
IF ($windreamSession.aLoggedin -eq $True) {
Write-Logfile -LogLine " "
Write-Logfile -LogLine "Connection established"
Write-Logfile -LogLine "You are connected with $($windreamConnect.ServerName) as $($windreamSession.aUser.aName)"
Write-Host "DEBUG Info: Do not forget to Logout Session after finished work."
$windreamDriveLetter = $windreamServerBrowser.GetServerValue($windreamServer, "DriveLetter", 0)
IF ($windreamDriveLetter) {
Write-Logfile -LogLine "The configured windream Drive Letter is: $windreamDriveLetter"
Set-Variable -Name windreamDriveLetter -Value $windreamDriveLetter -Scope Global -ErrorAction SilentlyContinue
} #end if
ELSE {
Write-Logfile -LogLine "WARNING: There is no windream Drive Letter configured."
Write-Logfile -LogLine "This could cause access problems!"
Write-Logfile -LogLine "Please check your windream Alias Settings!"
} #end else
Return $windreamSession
} #end if
ELSE {
Write-Logfile -LogLine " "
Write-Logfile -LogLine "Connection refused"
Write-Logfile -LogLine $Error
Return $False
} #end else
} #end if
#Stop if windream Server was unavailable
ELSE {
Write-Logfile -LogLine "Cannot retrieve windream Server to connect with or test connection failed!"
Write-Logfile -LogLine $Error
Return $False
} #end else
} #end if
ELSE {
Write-Host ""
Write-Host "DEBUG Info: Write-LogFile - Module does not exist!"
Write-Host "DEBUG Info: Please load the Module and try again, running this Function/Module!"
Write-Host "DEBUG Info: Exiting, because of this Issue."
EXIT
} #end else
} #end function

View File

@@ -1,190 +0,0 @@
Function Write-LogFile {
<#
.SYNOPSIS
Function will write a given String to a Logfile.
.DESCRIPTION
Just like the cmdlet Write-Host, this Function will display Output on the Console.
Parallel Output will be written into a designated LogFile.
It is recommended to init the LogPath Variable with $Null and the LogPaths Variable with a possible Path,
which has to be checked for accessible.
This is important, because if given Path was inaccessible (-> Access Test failed), Function will try some other Paths for accessible.
These are: The ScriptPath (\Logs) from, which triggerd this Function and $env:temp\Digital Data\$ScriptName\Logs.
After a successful Access Test, Function will set the Variable LogPath, with the first accessible Path tested.
Function will not give any Return Values, because if it is impossible to write a LogFile, Function will force the whole Script to exit.
.REQUIREMENT General
PowerShell V2
.REQUIREMENT Assembly
<NONE>
.REQUIREMENT Variables
PathTest, FileTest, Counter1, LogLine
.REQUIREMENT Variables preSet
LogFile, LogPath, LogPaths, ScriptName, ScriptPath
.REQUIREMENT Functions
<NONE>
.VERSION
Number: 2.0.0.0 / Date: 21.11.2016
.PARAMETER LogLine
Give the String you want to be written into the Logfile.
.EXAMPLE
Write-LogFile -LogLine "Write this in my Log, please."
.EXAMPLE
Write-LogFile -LogLine "Write this Variabel $Variable in my Log, please."
#>
[cmdletbinding()]
Param (
[Parameter(Position=0,Mandatory=$True,HelpMessage='Give the String you want to be written into the Logfile.')]
[AllowEmptyString()]
[String]$LogLine
) #end param
#Clear Error Variable
$error.clear()
# This if / else block is only for determine the LogPath
IF (!$LogPath) {
Write-Host ""
Write-Host "DEBUG Info: LogPath is currently not set!"
[Array]$LogPaths = $LogPaths
[Array]$LogPaths = ($LogPaths += "$ScriptPath\Logs","$env:temp\Digital Data\$ScriptName\Logs")
[int]$Counter1 = 0
DO {
#Determine the current Array object
[String]$LogPath = [Array]$($LogPaths[$Counter1])
Write-Host ""
Write-Host "DEBUG Info: Testing LogPath: $LogPath"
$PathTest = Test-Path -PathType Container "$LogPath"
#Check if Path already exists
IF ($PathTest -eq $True) {
Write-Host "DEBUG Info: LogPath seems already to exists: $LogPath"
} #end if
ELSE {
#If Path doesnt exist, try to create it!
Try {
Write-Host "DEBUG Info: Trying to create LogPath: $LogPath"
New-Item -ItemType Directory -Path "$LogPath" -Force -ErrorAction Stop | Out-Null
Write-Host "DEBUG Info: Trying seems to be successful!"
} #end try
Catch {
Write-Host "DEBUG Info: Cannot create LogPath or access denied!"
Write-Host $Error
} #end catch
} #end else
#Check again if path exists
$PathTest = Test-Path -PathType Container "$LogPath"
IF ($PathTest -eq $True) {
Try {
Write-Host "DEBUG Info: Trying to write a TestFile into the LogPath."
New-Item -ItemType File -Path "$LogPath\AccessTest.txt" -Force -ErrorAction Stop | Out-Null
Add-content "$LogPath\AccessTest.txt" -Value "This is a Test!" -Force -ErrorAction Stop | Out-Null
$FileTest = Test-Path -Path "$LogPath\AccessTest.txt" -PathType Leaf -ErrorAction Stop
Remove-Item -Path "$LogPath\AccessTest.txt" -Force -ErrorAction Stop | Out-Null
Write-Host "DEBUG Info: Write Test seems to be successful."
Set-Variable -Name LogPath -Value $LogPath -Scope Global -Force
} #end try
Catch {
Write-Host "DEBUG Info: Cannot write into LogPath or access denied!"
Write-Host $Error
} #end catch
} #end if
ELSE {
Write-Host "DEBUG Info: Cannot create LogPath or access denied!"
Write-Host $Error
} #end else
[int]$Counter1++ | Out-Null
} #end do
UNTIL ((($PathTest -eq $True) -and ($FileTest -eq $True)) -or ($Counter1 -eq $($LogPaths.count)) )
} #end if
ELSEIF ($LogPath) {
#Write-Host "DEBUG Info: LogPath was already been set!"
#Write-Host "DEBUG Info: LogPath is $LogPath"
} #end elseif
ELSE {
Write-Host "Unexpected Error!"
Write-Host $Error
Return $False
} #end else
IF ($LogPath) {
#After LogPath determination - try to log the string
Try {
Write-Host "$LogLine"
Add-content $LogPath\$LogFile -value "$(Get-Date -Format 'dd.MM.yyyy')-$(Get-Date -Format 'HH:mm:ss'): $LogLine" -ErrorAction Stop
} #end try
Catch {
Write-Host "DEBUG Info: Cannot write to LogFile!"
Write-Host "DEBUG Info: Exiting, because of this Issue."
Write-Host $Error
EXIT
} #end catch
} #end if
ELSE {
Write-Host "DEBUG Info: Cannot write to LogFile!"
Write-Host "DEBUG Info: Exiting, because of this Issue."
Write-Host $Error
EXIT
} #end else
} #end function

View File

@@ -1,23 +0,0 @@
ArchiveFolder "foo.zip", "Testordner"
Sub ArchiveFolder (zipFile, sFolder)
With CreateObject("Scripting.FileSystemObject")
zipFile = .GetAbsolutePathName(zipFile)
sFolder = .GetAbsolutePathName(sFolder)
With .CreateTextFile(zipFile, True)
.Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, chr(0))
End With
End With
With CreateObject("Shell.Application")
.NameSpace(zipFile).CopyHere .NameSpace(sFolder).Items
Do Until .NameSpace(zipFile).Items.Count = _
.NameSpace(sFolder).Items.Count
WScript.Sleep 1000
Loop
End With
End Sub

View File

@@ -1,37 +0,0 @@
Public Function ConvertFromSecureString(Ciphertext)
'Stand: 26.08.2020
'Source: https://gist.github.com/albert1205/c8430b5bfa505f9308e4fa789b9b1d7f
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
'Call DecryptTool

View File

@@ -1,41 +0,0 @@
Public Function ConvertToSecureString(Plaintext)
'Stand: 26.08.2020
'Source: https://gist.github.com/albert1205/c8430b5bfa505f9308e4fa789b9b1d7f
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

View File

@@ -1,143 +0,0 @@
' GetDateByWeekdayname
' ----------------------------------------------------------------------------
' Diese Funktion errechnet das Datum eines übergebenen Wochentages
' Parameter 1 (pWeekdayname) = Übergabe des zu ermittelnden Wochentags (Bsp.: "Montag","Dienstag","Mittwoch","Donnerstag","Freitag","Samstag","Sonntag")
' Parameter 2 (pFromDate) = Übergabe des Datums, ab wann gerechnet werden soll (Bsp.: "01.01.2022")
' Parameter 3 (pIncludeToday) = Übergabe "True" oder "False" um den aktuellen Tag in die Ermittlung einzubeziehen.
' Parameter 4 (pSkipTodayByTime) = Übergabe einer Uhrzeit (Bsp.: "12:00"), bis wann der aktuelle Tag miteinbezogen werden soll.
' Sofern nicht mit "99:99" oder "NULL" abgeschaltet, übersteuert Parameter 4 immer Parameter 3.
'
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow@digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 05.10.2021 / MK
' Version Date / Editor: 12.10.2021 / MK
' Version Number: 1.3.0.0
Function GetDateByWeekdayname(pWeekdayname,pFromDate,pIncludeToday,pSkipTodayByTime)
'Set vars. Set current date and day and nr
IF (GetLocale() = 1031) then
Weekdaynames = Array("Sonntag","Montag","Dienstag","Mittwoch","Donnerstag","Freitag","Samstag")
Else 'Tag 1 2 3 4 5 6 7
Weekdaynames = Array("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday")
End if
'Evaluate parameter pFromDate
IF (pFromDate = "today") Then
FromDate = Date()
Else
FromDate = cdate(pFromDate)
End if
IF (IsDate(FromDate) = True) Then
CurrentDayNumber = Weekday(FromDate)
CurrentDayOfWeek = Weekdayname(CurrentDayNumber,False,1)
CurrentTime = TimeValue(Now())
'Evaluate parameter pSkipTodayByTime
If (pSkipTodayByTime <> "99:99") and (pSkipTodayByTime <> "NULL") Then
On Error Resume Next
TimeValue(pSkipTodayByTime)
If (Err.number = 0) and (CLng(Replace(CurrentTime,":","")) > CLng(Replace(TimeValue(pSkipTodayByTime),":",""))) then
IncludeToday = False
Else
IncludeToday = True
End if
Else
'Fallback if parameter ist not bool
IF (VarType(pIncludeToday) = 11) Then
IncludeToday = pIncludeToday
Else
IncludeToday = False
End If
End if
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MsgBox "Looking for next: " & vbCrlf & _
"pWeekdayname " & pWeekdayname & vbCrlf & _
"FromDate " & FromDate & vbCrlf & _
"pIncludeToday " & pIncludeToday & vbCrlf & _
"IncludeToday " & IncludeToday & vbCrlf & _
"pSkipTodayByTime " & pSkipTodayByTime & vbCrlf & vbCrlf & _
"CurrentDayOfWeek: " & CurrentDayOfWeek & vbCrlf & _
"CurrentDayNumber: " & CurrentDayNumber & vbCrlf & _
"",,"DEBUG - GetDateByWeekdayname - Parameter given:"
End If
CalcDate = FromDate
CalcDayNumber = CurrentDayNumber
Counter = 0
DO
'If pIncludeToday = False, skip the current FromDate and add one day
IF (IncludeToday = False) then
Counter = Counter + 1
CalcDayNumber = CalcDayNumber + 1
End If
'Reset day, but keep counter
IF (CalcDayNumber > 7) Then
CalcDayNumber = 1
end if
CalcDate = Dateadd("d", + counter, FromDate)
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MsgBox "pWeekdayname: " & pWeekdayname & vbCrlf & _
"pFromDate: " & pFromDate & vbCrlf & _
"pIncludeToday: " & pIncludeToday & vbCrlf & _
"pSkipTodayByTime: " & pSkipTodayByTime & vbCrlf & vbCrlf & _
"Counter: " & Counter & vbCrlf & _
"CalcDayNumber: " & CalcDayNumber & vbCrlf & _
"CalcWeekdayname: " & Weekdayname(CalcDayNumber,False,1) & vbCrlf & _
"CalcWeekday: " & Weekday(CalcDayNumber) & vbCrlf & _
"CalcDate: " & CalcDate,, "DEBUG - GetDateByWeekdayname - Loop " & Counter
End If
CalcDayOfWeek = Weekdayname(CalcDayNumber,False,1)
'Failsafe to prevent endless loops
IF ((CalcDayOfWeek = pWeekdayname) or (Counter = 31)) THEN EXIT DO
'If pIncludeToday = True, dont skip the current FromDate
IF (IncludeToday = True) then
Counter = Counter + 1
CalcDayNumber = CalcDayNumber + 1
End If
LOOP
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MsgBox "Errechnet: " & cdate(CalcDate),,"DEBUG - GetDateByWeekdayname - Ergebnis"
End if
Else
CalcDate = "01.01.1970"
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MsgBox "Ungültiges Datum, failsafe auf: 01.01.1970",,"DEBUG - GetDateByWeekdayname - Ergebnis"
End if
End if
'Return calculated date
GetDateByWeekdayname = cdate(CalcDate)
end function 'GetDateByWeekdayname
'datetest = GetDateByWeekdayname ("Dienstag","12.10.2021",false,"12:00")
'msgbox datetest

View File

@@ -1,3 +0,0 @@
Function GetLeftPad(Value)
GetLeftPad = Right("0" & Value, 2)
End Function

View File

@@ -1,77 +0,0 @@
Function GetWinLineDocDeliveryNoteByUnsplittedProducts(ProductNumber, WinLineMandatorNr, WinLineYear)
'Version date: 15.09.2020
Dim Conn, Result
Set Conn = CWLStart.CurrentCompany.Connection
If (ProductNumber <> "") and (WinLineMandatorNr <> "") and (WinLineYear <> "") Then
'c999 = cOrdnerNr
'c998 = cInvoiceNr
'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 <= N'TT1111001') "
SQL = SQL & ") as [c994] "
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 "
'MsgBox "SQL (Part 1): " & Mid(SQL, 1, 750)
'MsgBox "SQL (Part 2): " & Mid(SQL, 750)
Set Result = Conn.Select(SQL)
'msgbox "egal was"
'test = result.rowcount
'msgbox "type: " & TypeName(result)
'msgbox "result: " & result
'msgbox "Rowcount: " & test
'msgbox "result: " & result.value("c999")
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

View File

@@ -1,268 +0,0 @@
Function GetWinLineDocInfoByAccountAndRunningNr(DocAccountAndRunningNr, PostingType, WinLineDocType)
'Stand 08.01.2021
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

View File

@@ -1,91 +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 Modul 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 no Array!" & vbCrlf & _
"",,"DEBUG Info: Parameter is no Array - GetWinLineDocUniqueIdentifierParams"
End If
GetWinLineDocUniqueIdentifier = ""
End if
End Function 'GetWinLineDocUniqueIdentifier

View File

@@ -1,32 +0,0 @@
Function GetWinLineInternalProductNumber(ProductNumber, SerialNumber)
Set Conn = CWLStart.CurrentCompany.Connection
If SerialNumber = "" Then
GetWinLineInternalProductNumber = ProductNumber
Else
SQL = "SELECT [c002] FROM [v021] (NOLOCK) WHERE [c011] = '"& ProductNumber &"' AND [c068] = '"& SerialNumber &"' " & 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

View File

@@ -1,42 +0,0 @@
' Version Date: 05.01.2021
Function GetWinLineOriginalLineNumber(OrderNumber, ArticleNumber, IsSerialNumberArticle)
Set Conn = CWLStart.CurrentCompany.Connection
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

View File

@@ -1,35 +0,0 @@
Function GetWinLineProductInfoByProductNumber(ProductNumber, WinLineMandatorNr, WinLineYear)
'Version Date 23.09.2020
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 ' GetWinLineProductInfoByProductNumber

View File

@@ -1,23 +0,0 @@
' Version Date: 13.10.2020
Function GetWinLineStockedAmount(ProductNumber, IncludeSalesDocuments)
' 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 & "(SELECT C009 AS [MengeAbgang] 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

View File

@@ -1,62 +0,0 @@
' Version Date: 07.01.2021
Function GetWinLineStorageLocation(ProductNumber, ProductSerialNumber, IsSerialNumberArticle)
Set Conn = CWLStart.CurrentCompany.Connection
' Get 'Lagerortstruktur' for Product
SQL = "SELECT c178 FROM [V021] (NOLOCK) WHERE c010 = '"& ProductNumber &"'"
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

View File

@@ -1,292 +0,0 @@
'Function to load VBS modules
Public Function LoadVBSModule(VBSModuleParams)
'SYNOPSIS
'Function will load external - additional - VBS Modules (VBME, VBM or VBS File(s)) into current Script.
'DESCRIPTION
'By working With Modules, this Function Is necessary To load external Modul 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
'"VBSModuleParams(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, ModuleName, ModuleCode, ModulePath, WshShell, ModuleAutoSourcePath
'REQUIREMENT Variables preSet
'ModuleDefaultSourcePath (optional)
'REQUIREMENT Functions
'<NONE>
'VERSION
'Number: 1.6.0.0 / Date: 06.07.2023
'PARAMETER VBSModuleParams(0) = ModuleName
'Give the Module Name, you want to load into the current VB-Script.
'PARAMETER VBSModuleParams(1) = ModuleOverrideSourcePath
'Optional Parameter. By giving the ModuleOverrideSourcePath, Function will not check other Paths for the Function you want to load.
'EXAMPLE
'Dim VBSModuleParams
'Redim VBSModuleParams(0)
'VBSModuleParams(0) = Module
'LoadVBSModule(VBSModuleParams)
'EXAMPLE
'Dim VBSModuleParams
'Redim VBSModuleParams(1)
'VBSModuleParams(0) = Module
'VBSModuleParams(1) = "D:\ScriptFiles\Modules"
'LoadVBSModule(VBSModuleParams)
On Error Resume Next
'Clear Error Variable
Err.Clear
Dim FSOModule, Module, ModuleName, ModuleCode, ModulePath, WshShell, ModuleAutoSourcePath
Set FSOModule = CreateObject("Scripting.FileSystemObject")
'How many parameters are given in the array
If (UBound(VBSModuleParams) = 0) Then
ModuleName = VBSModuleParams(0)
If FSOModule.FolderExists(ModuleDefaultSourcePath) Then
'If global var is set, take it!
ModulePath = ModuleDefaultSourcePath
ELSE
'Getting the current dir, when ModuleDefaultSourcePath does not exist
Set WshShell = CreateObject("WScript.Shell")
ModuleAutoSourcePath = WshShell.CurrentDirectory
'By this parameter way the path is more variable
ModulePath = ModuleAutoSourcePath & "\" & "Modules"
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MSGBOX "Parameter1 = " & VBSModuleParams(0) & vbCrlf & _
"ModuleDefaultSourcePath = " & ModuleDefaultSourcePath,,"DEBUG Info: Parameter Values in Array - VBSModuleParams"
End If
End if
ElseIf (UBound(VBSModuleParams) = 1) Then
ModuleName = VBSModuleParams(0)
ModulePath = VBSModuleParams(1)
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MSGBOX "Parameter1 = " & VBSModuleParams(0) & vbCrlf & _
"Parameter2 = " & VBSModuleParams(1),,"DEBUG Info: Parameter Values in Array - VBSModuleParams"
End If
Else
msgbox "Invalid function call!" & vbCrlf & _
"Please check the parameters!" & vbCrlf & _
"...then restart this Script!",vbExclamation ,"LoadVBSModule: Parameter Error!"
End if
'Checking folder paths 'Check if given path is valid, if not create it
If Not FSOModule.FolderExists(ModulePath) Then
FSOModule.CreateFolder(ModulePath)
msgbox "The ModulePath doesnt exist, trying to create!" & vbCrlf & _
"Please place your Modules there: " & vbCrlf & _
ModulePath & vbCrlf & vbCrlf & _
"...then restart this Script!",vbExclamation ,"LoadVBSModule: Modules / ModulePath is missing!"
Else
'Clear Error Variable
Err.Clear
'does the file exist? vbm is preferred!
If FSOModule.FileExists((ModulePath & "\" & Modulename & ".vbme")) Then
ModuleFullName = ModulePath & "\" & Modulename & ".vbme"
'does the file exist? vbm is preferred!
ElseIf FSOModule.FileExists((ModulePath & "\" & Modulename & ".vbm")) Then
ModuleFullName = ModulePath & "\" & Modulename & ".vbm"
'does the file exist?
Elseif FSOModule.FileExists((ModulePath & "\" & Modulename & ".vbs")) Then
ModuleFullName = ModulePath & "\" & Modulename & ".vbs"
Else 'Otherwise set empty string to var
ModuleFullName = Empty
End if
If (ModuleFullName = Empty) Then
MSGBOX "ModulePath cannot be determined! " & vbCrlf & _
"Path: " & ModulePath & "\" & Modulename & vbCrlf & _
"",vbOkayonly+vbCritical,"ERROR: Module does NOT exist! "
Err.Clear
LoadVBSModule = False
Else
Set Module = CreateObject("ADODB.Stream")
'IF ADODB object could not be created, fallback
If (Err.Number = 0) Then
Module.CharSet = "utf-8"
Module.Open
Module.LoadFromFile(ModuleFullName)
ModuleCode = Module.ReadText()
Module.Close
Else
Set Module = FSOModule.OpenTextFile(ModuleFullName, 1)
ModuleCode = Module.ReadAll
Module.Close
End If
Set Module = Nothing
'Code block for decrypting - need function decode
Const TagInit = "#@~^" '#@~^awQAAA==
Const TagFin = "==^#~@" '& chr(0)
If (Instr(ModuleCode,TagInit) > 0) and (Instr(ModuleCode,TagFin) > 0) Then
Do
FCode=0
DebCode = Instr(ModuleCode,TagInit)
If DebCode>0 Then
If (Instr(DebCode,ModuleCode,"==")-DebCode)=10 Then 'If "==" follows the tag
FCode=Instr(DebCode,ModuleCode,TagFin)
If FCode>0 Then
ModuleCode=Left(ModuleCode,DebCode-1) & _
Decode(Mid(ModuleCode,DebCode+12,FCode-DebCode-12-6)) & _
Mid(ModuleCode,FCode+6)
End If
End If
End If
Loop Until FCode=0
End If
'Execute the file content
ExecuteGlobal ModuleCode
If Err.Number <> 0 Then
MSGBOX "Error Code: " & Err.Number & vbCrlf & _
"Error Description: " & Err.Description & vbCrlf & _
"Path: " & ModuleFullName & vbCrlf & _
"",vbOkayonly+vbCritical,"ERROR: Module cannot be loaded!"
Err.Clear
LoadVBSModule = False
Else
LoadVBSModule = True
End If
End If
End If
End Function 'LoadVBSModule
Private Function Decode(Csrc)
Dim se,i,c,j,index,CsrcTemp
Dim tDecode(127)
Const Comb ="1231232332321323132311233213233211323231311231321323112331123132"
Set se= CreateObject("Scripting.Encoder")
For i=9 To 127
tDecode(i)="JLA"
Next
For i=9 To 127
CsrcTemp=Mid(se.EncodeScriptFile(".vbs",String(3,i),0,""),13,3)
For j=1 To 3
c=Asc(Mid(CsrcTemp,j,1))
tDecode(c)=Left(tDecode(c),j-1) & chr(i) & Mid(tDecode(c),j+1)
Next
Next
tDecode(42)=Left(tDecode(42),1) & ")" & Right(tDecode(42),1)
Set se=Nothing
Csrc=Replace(Replace(Csrc,"@&",chr(10)),"@#",chr(13))
Csrc=Replace(Replace(Csrc,"@*",">"),"@!","<")
Csrc=Replace(Csrc,"@$","@")
index=-1
For i=1 To Len(Csrc)
c=asc(Mid(Csrc,i,1))
If c<128 Then index=index+1
If (c=9) Or ((c>31) And (c<128)) Then
If (c<>60) And (c<>62) And (c<>64) Then
Csrc=Left(Csrc,i-1) & Mid(tDecode(c),Mid(Comb,(index Mod 64)+1,1),1) & Mid(Csrc,i+1)
End If
End If
Next
Decode=Csrc
End Function 'Decode
'======================================================================================================
'---------------------------------- EXAMPLE TO CALL THE FUNCTION(s) -----------------------------------
'======================================================================================================
'
''Prepare Array (Arrays are zero based!)
'Modules = Array("TestModule1","TestModule2","TestModule3")
'
' Dim Module
'
' 'Load external Modules.
' For Each Module In Modules
'
' If (Module <> "") Then
'
' 'Create the array to pass in to our function
' Dim VBSModuleParams
'
' 'Call the subroutine with two arguments
' Redim VBSModuleParams(0) 'Change to 1, for 2 values
' VBSModuleParams(0) = Module
' 'VBSModuleParams(1) = ""
'
' LoadVBSModuleResult = LoadVBSModule(VBSModuleParams)
'
' If (LoadVBSModuleResult <> True) Then
'
' 'Set WScript = CreateObject("WScript.Shell")
' MSGBOX "Module: " & Module & " was Not succesful been loaded!" & vbCrlf & _
' "Please load the Module and try again, running this Function/Module!" & vbCrlf & _
' "Exiting, because of this Issue." & vbCrlf & _
' Err.Description, vbCritical, "DEBUG Info: Cannot load Module!"
' 'WScript.Quit = not possible in Winline enviroment
'
' End If 'LoadVBSModuleResult
'
' End If 'Module <> ""
'
' Next 'end for each
'
'TestModule1
'TestModule2
'TestModule3
'------------------------------------------------------------------------------------------------------

View File

@@ -1,19 +0,0 @@
' Version Date: 30.09.2020
' Source: https://stackoverflow.com/questions/25067839/format-xml-string-in-vbscript
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

@@ -1,41 +0,0 @@
Function RemoveDuplicatesFromArray(arrItems)
'Source: https://devblogs.microsoft.com/scripting/how-can-i-delete-duplicate-items-from-an-array/
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
'For Each strItem in arrItems
' msgbox strItem
'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

View File

@@ -1,20 +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

View File

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

View File

@@ -1,4 +0,0 @@
Sub ShowDebugBox(Title)
MsgBox DEBUG_MESSAGE, vbOkonly, DEBUG_TITLE & " - " & Title
DEBUG_MESSAGE = ""
End Sub

View File

@@ -1,16 +0,0 @@
Sub ShowWinLineDocForEditing
'Version Date 22.09.2020
'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

View File

@@ -1,34 +0,0 @@
Sub ShowWinLineDocOverview(DocNumber, AccountNumber, RunningNumber)
'Version Date 22.09.2020
'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

View File

@@ -1,21 +0,0 @@
Sub ShowWinLineMandatorAndWinLineYear(WinLineMandatorNr, WinLineYear)
'Version Date 22.09.2020
'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

View File

@@ -1,12 +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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

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

@@ -1,20 +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 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

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

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

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

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

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

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

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

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

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

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

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

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

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

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