Skriptentwickung/archive/EXPORT-WINLINE_DOCUMENT_METADATA/Archiv/EXPORT-WINLINE_DOCUMENT_METADATA.vb

'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

'##################################