8
0

Anlage des Repos

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

View File

@@ -0,0 +1,131 @@
' VB Script Document
' Caller Script, to start the export Script for WinLine document metadata.
'
' Digital Data
' Ludwig-Rinn-Straße 16
' 35452 Heuchelheim
' Tel.: 0641 / 202360
' E-Mail: info-flow(at)digitaldata.works
'
' Version Number: 1.0.0.0
' Version Date: 25.08.2020
On Error Resume Next
'########## set variables ##########
DIM MacroParameter(3)
'Set Debug Messages on (Enabled) or of.
DebugMode = "disEnabled"
'Set die WinLine Macro which should be executed at the end
DocMetaDataExport_Macro = "EXPORT-WINLINE_DOCUMENT_METADATA"
'Get current MandantorNr, like "500M".
WinLineCurrentMandatorNr = Value (0,11)
'Get current meso year, like 1440 ((2020 - 1900) * 12 = 1440).
WinLineCurrentYear = Value (0,5)
'The current type from program var (1= Anfrage/Angebot; 2= Auftrag/Bestellung; 3= Lieferschein; 4=Rechnung)
WinLineDocType = Value (0,20)
'The current type from doc head (1= Anfrage/Angebot; 2= Auftrag/Bestellung; 3= Lieferschein; 4=Rechnung)
DocType = Value (25,139)
'debitor doc = 1 / creditor doc = 2
PostingType = Value (357,6)
'Current "Laufnummer"
DocRunningNr = Value (0,31)
'Current "Laufnummer" - special case "Lieferschein"
DocDeliveryNoteNrRunningNr = Value (0,69)
'Number of the Offer ("Angebot")
DocOfferNr = Value (0,34)
'Number of the Order ("Angebot")
DocOrderNr = Value (0,35)
'Number of delivery note ("Lieferschein")
DocDeliveryNoteNr = Value (0,36)
'Number of the Invoice ("Rechung")
DocInvoiceNr = Value (0,37)
'Unique Key for T025 c000
DocAccountAndRunningNr = Value (25,0)
'When the doc ("Beleg") was created
DocCreated = Value (25,59)
'When the doc ("Beleg") was last changed
DocLastChange = Value (25,60)
'The ten "Belegkopfnotizen"
DocHeadText1 = Value (25,63)
DocHeadText2 = Value (25,64)
DocHeadText3 = Value (25,65)
DocHeadText4 = Value (25,66)
DocHeadText5 = Value (25,67)
DocHeadText6 = Value (25,68)
DocHeadText7 = Value (25,69)
DocHeadText8 = Value (25,70)
DocHeadText9 = Value (25,71)
DocHeadText10 = Value (25,72)
'####################################
'########## preparing part ##########
'Reset Error Var
Err.Clear
'Special case on delivery note, replace order runningnr with delivery note nr
IF (DocDeliveryNoteNrRunningNr <> "") Then
DocAccountAndRunningNr = Replace(DocAccountAndRunningNr, DocRunningNr, DocDeliveryNoteNrRunningNr)
end if
'###############################
'########## main part ##########
'DocHeadText7 = Shop Rechnungsnummer; DocHeadText8 = Trackingnummer
IF ((DocDeliveryNoteNr <> "") or (DocInvoiceNr <> "")) and (PostingType = 1) and (DocHeadText7 <> "") Then
IF DebugMode = "Enabled" THEN
MSGBOX "Calling Macro: " & DocMetaDataExport_Macro & vbCrLf & vbCrLf & _
"DocAccountAndRunningNr: " & DocAccountAndRunningNr & vbCrLf & _
"PostingType: " & PostingType & vbCrLf & _
"WinLineDocType: " & WinLineDocType & vbCrLf & _
"DocType: " & DocType, , "DEBUG - Info: Export Metadata - Parameters ok!"
END IF
MacroParameter(0) = DebugMode
MacroParameter(1) = DocAccountAndRunningNr
MacroParameter(2) = DocType
MacroParameter(3) = PostingType
pParams = MacroParameter
CWLStart.MacroCommands.MRunMacroSuspended DocMetaDataExport_Macro, pParams
'CWLStart.MacroCommands.MWait 500
ELSE
IF DebugMode = "Enabled" THEN
MSGBOX "Calling Macro: " & DocMetaDataExport_Macro & vbCrLf & vbCrLf & _
"DocAccountAndRunningNr: " & DocAccountAndRunningNr & vbCrLf & _
"PostingType: " & PostingType & vbCrLf & _
"WinLineDocType: " & WinLineDocType & vbCrLf & _
"DocType: " & DocType, , "DEBUG - Info: Export Metadata - Parameters MISSING!"
END IF
ResultValue = ""
end if
'###############################

View File

@@ -0,0 +1,39 @@
/******
SQL Anlage Skript für die Shop Rückmeldungen
Stand: 25.08.2020
-> Datenbankverbindung im Program Makro (EXPORT-WINLINE_DOCUMENT_METADATA) prüfen!
-> Der meso Benutzer muss Zugriff auf die Datenbank / Tabelle haben!
******/
SET ANSI_NULLS ON
GO
SET QUOTED_IDENTIFIER ON
GO
CREATE TABLE [dbo].[EX_WEBSHOP-BELEGE](
[GUID] [int] IDENTITY(1,1) NOT NULL,
[MANDANT] [varchar](4) NOT NULL,
[WIRTSCHAFTSJAHR] [smallint] NOT NULL,
[BELEG_ART] [varchar](50) NOT NULL,
[BELEG_NR] [varchar](50) NOT NULL,
[BELEG_KONTO_UND_LAUFNUMMER] [nvarchar](50) NOT NULL,
[BELEG_KOMMENTAR] [varchar](max) NULL,
[BELEG_ERSTELLT_WANN] [datetime] NOT NULL,
[BELEG_GEAENDERT_WANN] [datetime] NULL,
[BELEG_KOPFTEXT1] [varchar](100) NULL,
[BELEG_KOPFTEXT2] [varchar](100) NULL,
[BELEG_KOPFTEXT3] [varchar](100) NULL,
[BELEG_KOPFTEXT4] [varchar](100) NULL,
[BELEG_KOPFTEXT5] [varchar](100) NULL,
[BELEG_KOPFTEXT6] [varchar](100) NULL,
[BELEG_KOPFTEXT7] [varchar](100) NULL,
[BELEG_KOPFTEXT8] [varchar](100) NULL,
[BELEG_KOPFTEXT9] [varchar](100) NULL,
[BELEG_KOPFTEXT10] [varchar](100) NULL
) ON [PRIMARY] TEXTIMAGE_ON [PRIMARY]
GO

View File

@@ -0,0 +1,15 @@
-------------------------------------------------------------------------------
Version 1.0.0.0 - 25.08.2020
NEW: -
FIX: -
CHG: -
REM: -
-------------------------------------legend------------------------------------
NEW: = Added a new functionality
FIX: = Fixed a Issue with existing functionality
CHG: = Changed a existing functionality
REM: = Removed a functionality
-------------------------------------------------------------------------------

View File

@@ -0,0 +1,385 @@
'Remark: Digital Data - Datenbank Eingriff zur Übermittlung von Belegmetadaten an ein externes System.
'VB Script Document
'
'Digital Data
'Ludwig-Rinn-Straße 16
'35452 Heuchelheim
'Tel.: 0641 / 202360
'E-Mail: info-flow(at)digitaldata.works
'
'Version Number: 1.1.0.0
'Version Date: 25.09.2020
On Error Resume Next
'########## get parameter #########
'Necessary to get parameters in the code. Do not change!
params = MParameters
'Parameter 1 to 19 are reserved by WinLine interal function
'First call parameter = control debug mode
paramDebugMode = params(20)
'Second call parameter = unique key
paramDocAccountAndRunningNr = params(21)
'Third call parameter = (1= Anfrage/Angebot; 2= Auftrag/Bestellung; 3= Lieferschein; 4=Rechnung)
paramDocType = params(22)
'Fourth call parameter = debitor doc = 1 / creditor doc = 2
paramPostingType = params(23)
'##################################
'########## set constants #########
'Get current MandantorNr, like "500M".
WinLineCurrentMandatorNr = CWLStart.CurrentCompany.Nr
'Get current meso year, like 1440 ((2020 - 1900) * 12 = 1440).
WinLineCurrentYear = CWLStart.CurrentCompany.CompanyYear
'Get current username like "meso".
WinLineCurrentUser = CWLStart.CurrentUser.Account
'Get current WinLine exe path
WinLineAppPath = CWLStart.Application.AppPath
'Get current date and time.
Timestamp = Now
'Basic SQL where for mandator and curruent mesoyear
SQLQuery_BasicWhere = " and (mesocomp = '" & WinLineCurrentMandatorNr &"') and (mesoyear = " & WinLineCurrentYear & ")"
'##################################
'########## set variables #########
'Debug (Debug Meldungen anzeigen)
DEBUG_ON = false
DEBUG_MESSAGE = ""
DebugMode = paramDebugMode
'Set path for Digital Data Modules. Default: Mandator additional field 10 (IF-ModulPfad-DigitalData) = CWLStart.CurrentCompany.Value(209)
ModuleDefaultSourcePath = CWLStart.CurrentCompany.Value(209)
'SQL DB for Metadata Export
SQLDatabase_EXIM = "[EXIM_MEDS]"
'SQL TB in DB for Metadata Export
SQLTable_EXIM = "[dbo].[EX_WEBSHOP_BELEGE]"
'Set SQL Table and Query for DocHead. Default: "T025"
SQLTable_DocHead = "[T025]"
SQLQuery_DocHead = "c000 = '" & paramDocAccountAndRunningNr & "'" & SQLQuery_BasicWhere
'##################################
'########## functions and subs #########
'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
'##################################
'######### preparing part #########
'Reset Error Var
Err.Clear
'Display debug infos, if enabled
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
AddDebugLine "CurrentUser: " & CurrentUser
AddDebugLine "MandatorNr: " & MandatorNr
AddDebugLine "CurrentYear: " & CurrentYear
AddDebugLine "Timestamp: " & Timestamp
ShowDebugBox "Runtime Variables"
CRLF = chr(13)&chr(10)
msg = "Parameter:" & CRLF
For i = 1 To Ubound(params)
msg = msg & i & ".: " & params(i) & CRLF
Next
msgbox msg ,, "Macro Name: " & CWLMacro.MName
End If
'Prepare Array (Arrays are zero based!)
Modules = Array("AddDebugLine","ShowDebugBox","GetWinLineDocInfoByAccountAndRunningNr","SwitchWinLineGoToMacros")
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
'Get SQL row for the doc
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: 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: DocHead from Database table "& SQLTable_DocHead
End If
Elseif SQLResult_DocHead.RowCount = 1 Then
DocHead = SQLResult_DocHead
'get all needed values from T025 plus additional values
DocHead = GetWinLineDocInfoByAccountAndRunningNr(paramDocAccountAndRunningNr, paramPostingType, paramDocType)
DocCreatedWhen = DocHead(59)
DocLastChangeWhen = DocHead(60)
DocHeadText1 = DocHead(63)
DocHeadText2 = DocHead(64)
DocHeadText3 = DocHead(65)
DocHeadText4 = DocHead(66)
DocHeadText5 = DocHead(67)
DocHeadText6 = DocHead(68)
DocHeadText7 = DocHead(69)
DocHeadText8 = DocHead(70)
DocHeadText9 = DocHead(71)
DocHeadText10 = DocHead(72)
DocComment = DocHead(165)
DocType = DocHead(200)
DocNr = DocHead(201)
Else
If DebugMode = "Enabled" Then
MSGBOX "To many Rows found, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: DocHead from Database table "& SQLTable_DocHead
End If
End If
End If
'##################################
'########### main part ############
If (DocHead <> "") And (DocType <> "") Then
Set Conn = CWLStart.CurrentCompany.Connection
SQLInsert = ""
SQLInsert = SQLInsert & "INSERT INTO " & SQLDatabase_EXIM & "." & SQLTable_EXIM & " "
SQLInsert = SQLInsert & "([MANDANT], [WIRTSCHAFTSJAHR], [BELEG_ART], [BELEG_NR], [BELEG_KONTO_UND_LAUFNUMMER], [BELEG_KOMMENTAR], [BELEG_ERSTELLT_WANN], [BELEG_GEAENDERT_WANN], [BELEG_KOPFTEXT1], [BELEG_KOPFTEXT2], [BELEG_KOPFTEXT3], [BELEG_KOPFTEXT4], [BELEG_KOPFTEXT5], [BELEG_KOPFTEXT6], [BELEG_KOPFTEXT7], [BELEG_KOPFTEXT8], [BELEG_KOPFTEXT9], [BELEG_KOPFTEXT10])"
SQLInsert = SQLInsert & "VALUES('"& WinLineCurrentMandatorNr &"', '"& WinLineCurrentYear &"', '"& DocType &"', '"& DocNr &"', '"& paramDocAccountAndRunningNr &"', '"& DocComment & "', '"& DocCreatedWhen &"', '"& DocLastChangeWhen &"', '"& DocHeadText1 &"', '"& DocHeadText2 &"', '"& DocHeadText3 &"', '"& DocHeadText4 &"', '"& DocHeadText5 &"', '"& DocHeadText6 &"', '"& DocHeadText7 &"', '"& DocHeadText8 &"', '"& DocHeadText9 &"', '"& DocHeadText10 & "')"
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
msgbox SQLInsert
End If
'execute the insert command
SQLResult = Conn.ExecuteSQL(SQLInsert)
If (SQLResult = "falsch") Or (SQLResult = "false") Then
MSGBOX "Achtung: Fehler beim Export der Dokument Metadaten!" & vbCrlf & _
"Bitte infomieren Sie Ihren Admin, über Export Probleme mit/bei diesem Beleg!",vbOkonly+vbCritical,"Abgebrochene Metadaten Übergabe!"
End If
End If
'##################################
'########### final part ###########
'if DebugMode enabled or DebugOn is true, go to the Macro Window
SwitchWinLineGoToMacros
'##################################

View File

@@ -0,0 +1,132 @@
' VB Script Document
' Caller Script, to start the export Script for WinLine document metadata.
'
' Digital Data
' Ludwig-Rinn-Straße 16
' 35452 Heuchelheim
' Tel.: 0641 / 202360
' E-Mail: info-flow(at)digitaldata.works
'
' Version Number: 1.1.0.0
' Version Date: 12.11.2020
On Error Resume Next
'########## set variables ##########
DIM MacroParameter(3)
'Set Debug Messages on (Enabled) or of.
DebugMode = "disEnabled"
'Set die WinLine Macro which should be executed at the end
DocMetaDataExport_Macro = "EXPORT-WINLINE_DOCUMENT_METADATA"
'Get current MandantorNr, like "500M".
WinLineCurrentMandatorNr = Value (0,11)
'Get current meso year, like 1440 ((2020 - 1900) * 12 = 1440).
WinLineCurrentYear = Value (0,5)
'The current type from program var (1= Anfrage/Angebot; 2= Auftrag/Bestellung; 3= Lieferschein; 4=Rechnung)
WinLineDocType = Value (0,20)
'The current type from doc head (1= Anfrage/Angebot; 2= Auftrag/Bestellung; 3= Lieferschein; 4=Rechnung)
DocType = Value (25,139)
'debitor doc = 1 / creditor doc = 2
PostingType = Value (357,6)
'Current "Laufnummer"
DocRunningNr = Value (0,31)
'Current "Laufnummer" - special case "Lieferschein"
DocDeliveryNoteNrRunningNr = Value (0,69)
'Number of the Offer ("Angebot")
DocOfferNr = Value (0,34)
'Number of the Order ("Angebot")
DocOrderNr = Value (0,35)
'Number of delivery note ("Lieferschein")
DocDeliveryNoteNr = Value (0,36)
'Number of the Invoice ("Rechung")
DocInvoiceNr = Value (0,37)
'Unique Key for T025 c000
DocAccountAndRunningNr = Value (25,0)
'When the doc ("Beleg") was created
DocCreated = Value (25,59)
'When the doc ("Beleg") was last changed
DocLastChange = Value (25,60)
'The ten "Belegkopfnotizen"
DocHeadText1 = Value (25,63)
DocHeadText2 = Value (25,64)
DocHeadText3 = Value (25,65)
DocHeadText4 = Value (25,66)
DocHeadText5 = Value (25,67)
DocHeadText6 = Value (25,68)
DocHeadText7 = Value (25,69)
DocHeadText8 = Value (25,70)
DocHeadText9 = Value (25,71)
DocHeadText10 = Value (25,72)
'####################################
'########## preparing part ##########
'Reset Error Var
Err.Clear
'Special case on delivery note, replace order runningnr with delivery note nr
IF (DocDeliveryNoteNrRunningNr <> "") Then
DocAccountAndRunningNr = Replace(DocAccountAndRunningNr, DocRunningNr, DocDeliveryNoteNrRunningNr)
end if
'###############################
'########## main part ##########
'DocHeadText7 = Shop Rechnungsnummer; DocHeadText8 = Trackingnummer
IF ((DocDeliveryNoteNr <> "") or (DocInvoiceNr <> "")) and ((DocHeadText7 <> "") or (DocHeadText8 <> "")) and (PostingType = 1) Then
IF DebugMode = "Enabled" THEN
MSGBOX "Calling Macro: " & DocMetaDataExport_Macro & vbCrLf & vbCrLf & _
"DocAccountAndRunningNr: " & DocAccountAndRunningNr & vbCrLf & _
"PostingType: " & PostingType & vbCrLf & _
"WinLineDocType: " & WinLineDocType & vbCrLf & _
"DocType: " & DocType, vbInformation, "DEBUG - Info: Export Metadata - Parameters ok!"
END IF
MacroParameter(0) = DebugMode
MacroParameter(1) = DocAccountAndRunningNr
MacroParameter(2) = DocType
MacroParameter(3) = PostingType
pParams = MacroParameter
'CWLStart.MacroCommands.MRunMacroSuspended doesnt work when "Belegumstellung" is used. Use: "MRunMacro"!!!
CWLStart.MacroCommands.MRunMacro DocMetaDataExport_Macro, pParams
'CWLStart.MacroCommands.MWait 500
ELSE
IF DebugMode = "Enabled" THEN
MSGBOX "Calling Macro: " & DocMetaDataExport_Macro & vbCrLf & vbCrLf & _
"DocAccountAndRunningNr: " & DocAccountAndRunningNr & vbCrLf & _
"PostingType: " & PostingType & vbCrLf & _
"WinLineDocType: " & WinLineDocType & vbCrLf & _
"DocType: " & DocType, vbCritical, "DEBUG - Info: Export Metadata - Parameters MISSING!"
END IF
ResultValue = ""
end if
'###############################

View File

@@ -0,0 +1,39 @@
/******
SQL Anlage Skript für die Shop Rückmeldungen
Stand: 25.08.2020
-> Datenbankverbindung im Program Makro (EXPORT-WINLINE_DOCUMENT_METADATA) prüfen!
-> Der meso Benutzer muss Zugriff auf die Datenbank / Tabelle haben!
******/
SET ANSI_NULLS ON
GO
SET QUOTED_IDENTIFIER ON
GO
CREATE TABLE [dbo].[EX_WEBSHOP-BELEGE](
[GUID] [int] IDENTITY(1,1) NOT NULL,
[MANDANT] [varchar](4) NOT NULL,
[WIRTSCHAFTSJAHR] [smallint] NOT NULL,
[BELEG_ART] [varchar](50) NOT NULL,
[BELEG_NR] [varchar](50) NOT NULL,
[BELEG_KONTO_UND_LAUFNUMMER] [nvarchar](50) NOT NULL,
[BELEG_KOMMENTAR] [varchar](max) NULL,
[BELEG_ERSTELLT_WANN] [datetime] NOT NULL,
[BELEG_GEAENDERT_WANN] [datetime] NULL,
[BELEG_KOPFTEXT1] [varchar](100) NULL,
[BELEG_KOPFTEXT2] [varchar](100) NULL,
[BELEG_KOPFTEXT3] [varchar](100) NULL,
[BELEG_KOPFTEXT4] [varchar](100) NULL,
[BELEG_KOPFTEXT5] [varchar](100) NULL,
[BELEG_KOPFTEXT6] [varchar](100) NULL,
[BELEG_KOPFTEXT7] [varchar](100) NULL,
[BELEG_KOPFTEXT8] [varchar](100) NULL,
[BELEG_KOPFTEXT9] [varchar](100) NULL,
[BELEG_KOPFTEXT10] [varchar](100) NULL
) ON [PRIMARY] TEXTIMAGE_ON [PRIMARY]
GO

View File

@@ -0,0 +1,388 @@
'Remark: Digital Data - Datenbank Eingriff zur Übermittlung von Belegmetadaten an ein externes System.
'VB Script Document
'
'Digital Data
'Ludwig-Rinn-Straße 16
'35452 Heuchelheim
'Tel.: 0641 / 202360
'E-Mail: info-flow(at)digitaldata.works
'
'Version Number: 1.2.0.0
'Version Date: 08.01.2021
On Error Resume Next
'########## get parameter #########
'Necessary to get parameters in the code. Do not change!
params = MParameters
'Parameter 1 to 19 are reserved by WinLine interal function
'First call parameter = control debug mode
paramDebugMode = params(20)
'Second call parameter = unique key
paramDocAccountAndRunningNr = params(21)
'Third call parameter = (1= Anfrage/Angebot; 2= Auftrag/Bestellung; 3= Lieferschein; 4=Rechnung)
paramDocType = params(22)
'Fourth call parameter = debitor doc = 1 / creditor doc = 2
paramPostingType = params(23)
'##################################
'########## set constants #########
'Get current MandantorNr, like "500M".
WinLineCurrentMandatorNr = CWLStart.CurrentCompany.Nr
'Get current meso year, like 1440 ((2020 - 1900) * 12 = 1440).
WinLineCurrentYear = CWLStart.CurrentCompany.CompanyYear
'Get current username like "meso".
WinLineCurrentUser = CWLStart.CurrentUser.Account
'Get current WinLine exe path
WinLineAppPath = CWLStart.Application.AppPath
'Get current date and time.
Timestamp = Now
'Basic SQL where for mandator and curruent mesoyear
SQLQuery_BasicWhere = " and (mesocomp = '" & WinLineCurrentMandatorNr &"') and (mesoyear = " & WinLineCurrentYear & ")"
' Order SQL where for mandator and current and previous mesoyear
SQLQuery_OrderWhere = " and (mesocomp = '" & MandatorNr &"') and (mesoyear in (" & WinLineCurrentYear & "," & (WinLineCurrentYear - 12) & ") )"
'##################################
'########## set variables #########
'Debug (Debug Meldungen anzeigen)
DEBUG_ON = false
DEBUG_MESSAGE = ""
DebugMode = paramDebugMode
'Set path for Digital Data Modules. Default: Mandator additional field 10 (IF-ModulPfad-DigitalData) = CWLStart.CurrentCompany.Value(209)
ModuleDefaultSourcePath = CWLStart.CurrentCompany.Value(209)
'SQL DB for Metadata Export
SQLDatabase_EXIM = "[EXIM_MEDS]"
'SQL TB in DB for Metadata Export
SQLTable_EXIM = "[dbo].[EX_WEBSHOP_BELEGE]"
'Set SQL Table and Query for DocHead. Default: "T025"
SQLTable_DocHead = "[T025]"
SQLQuery_DocHead = "c000 = '" & paramDocAccountAndRunningNr & "'" & SQLQuery_BasicWhere
'##################################
'########## functions and subs #########
'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
'##################################
'######### preparing part #########
'Reset Error Var
Err.Clear
'Display debug infos, if enabled
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
AddDebugLine "CurrentUser: " & CurrentUser
AddDebugLine "MandatorNr: " & MandatorNr
AddDebugLine "CurrentYear: " & CurrentYear
AddDebugLine "Timestamp: " & Timestamp
ShowDebugBox "Runtime Variables"
CRLF = chr(13)&chr(10)
msg = "Parameter:" & CRLF
For i = 1 To Ubound(params)
msg = msg & i & ".: " & params(i) & CRLF
Next
msgbox msg ,, "Macro Name: " & CWLMacro.MName
End If
'Prepare Array (Arrays are zero based!)
Modules = Array("AddDebugLine","ShowDebugBox","GetWinLineDocInfoByAccountAndRunningNr","SwitchWinLineGoToMacros")
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
'Get SQL row for the doc
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: 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: DocHead from Database table "& SQLTable_DocHead
End If
Elseif SQLResult_DocHead.RowCount = 1 Then
DocHead = SQLResult_DocHead
'get all needed values from T025 plus additional values
DocHead = GetWinLineDocInfoByAccountAndRunningNr(paramDocAccountAndRunningNr, paramPostingType, paramDocType)
DocCreatedWhen = DocHead(59)
DocLastChangeWhen = DocHead(60)
DocHeadText1 = DocHead(63)
DocHeadText2 = DocHead(64)
DocHeadText3 = DocHead(65)
DocHeadText4 = DocHead(66)
DocHeadText5 = DocHead(67)
DocHeadText6 = DocHead(68)
DocHeadText7 = DocHead(69)
DocHeadText8 = DocHead(70)
DocHeadText9 = DocHead(71)
DocHeadText10 = DocHead(72)
DocComment = DocHead(165)
DocType = DocHead(200)
DocNr = DocHead(201)
Else
If DebugMode = "Enabled" Then
MSGBOX "To many Rows found, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: DocHead from Database table "& SQLTable_DocHead
End If
End If
End If
'##################################
'########### main part ############
If (DocHead <> "") And (DocType <> "") Then
Set Conn = CWLStart.CurrentCompany.Connection
SQLInsert = ""
SQLInsert = SQLInsert & "INSERT INTO " & SQLDatabase_EXIM & "." & SQLTable_EXIM & " "
SQLInsert = SQLInsert & "([MANDANT], [WIRTSCHAFTSJAHR], [BELEG_ART], [BELEG_NR], [BELEG_KONTO_UND_LAUFNUMMER], [BELEG_KOMMENTAR], [BELEG_ERSTELLT_WANN], [BELEG_GEAENDERT_WANN], [BELEG_KOPFTEXT1], [BELEG_KOPFTEXT2], [BELEG_KOPFTEXT3], [BELEG_KOPFTEXT4], [BELEG_KOPFTEXT5], [BELEG_KOPFTEXT6], [BELEG_KOPFTEXT7], [BELEG_KOPFTEXT8], [BELEG_KOPFTEXT9], [BELEG_KOPFTEXT10])"
SQLInsert = SQLInsert & "VALUES('"& WinLineCurrentMandatorNr &"', '"& WinLineCurrentYear &"', '"& DocType &"', '"& DocNr &"', '"& paramDocAccountAndRunningNr &"', '"& DocComment & "', '"& DocCreatedWhen &"', '"& DocLastChangeWhen &"', '"& DocHeadText1 &"', '"& DocHeadText2 &"', '"& DocHeadText3 &"', '"& DocHeadText4 &"', '"& DocHeadText5 &"', '"& DocHeadText6 &"', '"& DocHeadText7 &"', '"& DocHeadText8 &"', '"& DocHeadText9 &"', '"& DocHeadText10 & "')"
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
msgbox SQLInsert
End If
'execute the insert command
SQLResult = Conn.ExecuteSQL(SQLInsert)
If (SQLResult = "falsch") Or (SQLResult = "false") Then
MSGBOX "Achtung: Fehler beim Export der Dokument Metadaten!" & vbCrlf & _
"Bitte infomieren Sie Ihren Admin, über Export Probleme mit/bei diesem Beleg!",vbOkonly+vbCritical,"Abgebrochene Metadaten Übergabe!"
End If
End If
'##################################
'########### final part ###########
'if DebugMode enabled or DebugOn is true, go to the Macro Window
SwitchWinLineGoToMacros
'##################################

View File

@@ -0,0 +1,30 @@
-------------------------------------------------------------------------------
Version 1.1.0.0 - 25.09.2020
NEW: -
FIX: -
CHG: - New Module Loader Version
REM: -
-------------------------------------------------------------------------------
Version 1.0.1.0 - 26.08.2020
NEW: -
FIX: -
CHG: - New Module Loader Version
REM: -
-------------------------------------------------------------------------------
Version 1.0.0.0 - 25.08.2020
NEW: -
FIX: -
CHG: -
REM: -
-------------------------------------legend------------------------------------
NEW: = Added a new functionality
FIX: = Fixed a Issue with existing functionality
CHG: = Changed a existing functionality
REM: = Removed a functionality
-------------------------------------------------------------------------------