AppStd/Skriptentwickung
8
0
Fork 0
Code
Skriptentwickung/archive/Export-WinLineDoc/Archiv/DOCEXPORT_PDFE_Head-Formel.txt
KammM 38d6a271c4 Anlage des Repos
2024-01-24 16:42:38 +01:00

310 lines
13 KiB
Plaintext
Raw Blame History

' VB Script Document
'
' Export Script for WinLine documents.
' Configuration has to be done in SQL Tables TBDD_DOCEXPORT_CONFIG and TBDD_DOCEXPORT_PROFILE
'
' Digital Data
' Ludwig-Rinn-Straße 16
' 35452 Heuchelheim
' Tel.: 0641 / 202360
' E-Mail: info-flow(at)digitaldata.works
'
' Version Number: 2.0.0.0
' Version Date: 09.02.2020
On Error Resume Next
'########## set variables ##########
DIM MacroParameter(11), RUN_MACRO_GUID, RUN_APP_GUID, ReplaceItems, ReplaceKeys, LoopCounter, LoopCounter2
DocVersion = 1
DocVersionSeparator = "~"
ReplaceSpecialChar = ""
DebugMode = "Enabled"
MandatorNr = Value (0,11)
RecordNumber = Value (25,22)
HeadDocType = Value (25,139)
ProgramDocType = Value (0,20)
PostingType = Value (357,6)
DocFinalAmount = Value (25,100)
TBDD_DOCEXPORT_PROFILE = "T651"
TBDD_DOCEXPORT_PROFILE_SQL = "[U001] = 1 AND [u003] IN ('ALL','"& MandatorNr &"') AND [U004] = '"& ProgramDocType &"' AND [U005] = '"& HeadDocType &"' AND [U006] = '"& PostingType &"' AND [U011] IS NOT NULL AND [U012] IS NOT NULL"
TBDD_DOCEXPORT_CONFIG = "T650"
TBDD_DOCEXPORT_CONFIG_VARSQL = "[U001] = 1 AND [u003] IN ('ALL','"& MandatorNr &"') AND [U004] LIKE '%Variable%' AND [U005] IS NOT NULL AND [U006] IS NOT NULL AND [U007] IS NOT NULL AND [U008] IS NULL AND [U012] IS NULL"
SET FileSystemObject = CreateObject("Scripting.FileSystemObject")
SET ReplaceItems = CreateObject("Scripting.Dictionary")
ReplaceItems.CompareMode = vbTextCompare
'########## preparing part ##########
'Reset Error Var
Err.Clear
'Display debug infos, if enabled
IF DebugMode = "Enabled" THEN
MSGBOX "ProgramDocType: "& ProgramDocType & vbCrLf & _
"HeadDocType: " & HeadDocType & vbCrLf & _
"RecordNumber: " & RecordNumber & vbCrLf & _
"PostingType: " & PostingType,,"DEBUG - Info: WinLine Runtime Variables"
MSGBOX "Profile SQL:"& vbCrLf & TBDD_DOCEXPORT_PROFILE_SQL & vbCrLf & vbCrLf & _
"Var SQL: " & vbCrLf & TBDD_DOCEXPORT_CONFIG_VARSQL,,"DEBUG - Info: SQL Commands (not final!)"
END IF
'Replace Object, because functions are not available
ReplaceItems.ADD "%MandantenNr%",MandatorNr
ReplaceItems.ADD "%Laufnummer%",RecordNumber
ReplaceItems.ADD "%UserName%",TRIM(CSTR(Value (0,14)))
ReplaceItems.ADD "%KontoNr%",TRIM(CSTR(Value (0,30)))
ReplaceItems.ADD "%KontoName%",TRIM(CSTR(Value (50,3)))
ReplaceItems.ADD "%ProjektNr%",TRIM(CSTR(Value (25,136)))
ReplaceItems.ADD "%AngebotsNr%",TRIM(CSTR(Value (0,34)))
ReplaceItems.ADD "%AuftragsNr%",TRIM(CSTR(Value (0,35)))
ReplaceItems.ADD "%LieferscheinNr%",TRIM(CSTR(Value (0,36)))
ReplaceItems.ADD "%RechnungsNr%",TRIM(CSTR(Value (0,37)))
ReplaceItems.ADD "%AnfragenNr%",TRIM(CSTR(Value (0,34)))
ReplaceItems.ADD "%BestellNr%",TRIM(CSTR(Value (0,35)))
ReplaceItems.ADD "%Textzeile1%",TRIM(CSTR(Value (25,63)))
ReplaceItems.ADD "%Textzeile2%",TRIM(CSTR(Value (25,64)))
ReplaceItems.ADD "%Textzeile3%",TRIM(CSTR(Value (25,65)))
ReplaceItems.ADD "%Textzeile4%",TRIM(CSTR(Value (25,66)))
ReplaceItems.ADD "%Textzeile5%",TRIM(CSTR(Value (25,67)))
ReplaceItems.ADD "%Textzeile6%",TRIM(CSTR(Value (25,68)))
ReplaceItems.ADD "%Textzeile7%",TRIM(CSTR(Value (25,69)))
ReplaceItems.ADD "%Textzeile8%",TRIM(CSTR(Value (25,70)))
ReplaceItems.ADD "%Textzeile9%",TRIM(CSTR(Value (25,71)))
ReplaceItems.ADD "%Textzeile10%",TRIM(CSTR(Value (25,72)))
ReplaceItems.ADD "%Tag%",(day(date))
ReplaceItems.ADD "%Monat%",(month(date))
ReplaceItems.ADD "%Monatsname%",MonthName((month(date)))
ReplaceItems.ADD "%Jahr%",(Year(date))
'Code block to get document profile from table
IF (Mid(DocFinalAmount,1,1)) = "-" THEN
TBDD_DOCEXPORT_PROFILE_SQL = TBDD_DOCEXPORT_PROFILE_SQL & " AND [U007] = 'NegativAmount'"
END IF
SET TBDD_DOCEXPORT_PROFILE_RESULT = CWLStart.CurrentCompany.SearchRecord(TBDD_DOCEXPORT_PROFILE, TBDD_DOCEXPORT_PROFILE_SQL)
IF Err.Number <> 0 THEN
MSGBOX "Error Code: "& Err.Number & vbCrLf & _
"Error Description: "& Err.Description,,"ERROR: Getting Variables from DB Table "& TBDD_DOCEXPORT_PROFILE
Err.Clear
ELSE
IF TBDD_DOCEXPORT_PROFILE_RESULT = -1 Then
IF DebugMode = "Enabled" THEN
MSGBOX "No Rows found, SQL: "& vbCrLf & TBDD_DOCEXPORT_PROFILE_SQL,,"DEBUG - Info: Profiles from Database table "& TBDD_DOCEXPORT_PROFILE
END IF
ELSE
IF DebugMode = "Enabled" THEN
MSGBOX "WINLINE_ProgramDocType: " & TBDD_DOCEXPORT_PROFILE_RESULT.Value(4) & vbCrLf & _
"WINLINE_HeadDocType: " & TBDD_DOCEXPORT_PROFILE_RESULT.Value(5) & vbCrLf & _
"WINLINE_PostingType: " & TBDD_DOCEXPORT_PROFILE_RESULT.Value(6) & vbCrLf & _
"WINLINE_VARIABLE4: " & TBDD_DOCEXPORT_PROFILE_RESULT.Value(7) & vbCrLf & _
"WINLINE_VARIABLE5: " & TBDD_DOCEXPORT_PROFILE_RESULT.Value(8) & vbCrLf & _
"WINLINE_VARIABLE6: " & TBDD_DOCEXPORT_PROFILE_RESULT.Value(9) & vbCrLf & _
"WINLINE_VARIABLE7: " & TBDD_DOCEXPORT_PROFILE_RESULT.Value(10) & vbCrLf & vbCrLf & _
"DOCEXPORT_PATH: " & TBDD_DOCEXPORT_PROFILE_RESULT.Value(11) & vbCrLf & _
"DOCEXPORT_FILENAME: " & TBDD_DOCEXPORT_PROFILE_RESULT.Value(12) & vbCrLf & _
"DOCEXPORT_FILENAME_PREVIEW: "& TBDD_DOCEXPORT_PROFILE_RESULT.Value(13) & vbCrLf & _
"DOCEXPORT_FILEEXTENSION: " & TBDD_DOCEXPORT_PROFILE_RESULT.Value(14) & vbCrLf & _
"DOCEXPORT_VERSIONING: " & TBDD_DOCEXPORT_PROFILE_RESULT.Value(15),,"DEBUG - Info: document profile from Database table "& TBDD_DOCEXPORT_PROFILE
END IF
WINLINE_ProgramDocType = TBDD_DOCEXPORT_PROFILE_RESULT.Value(4)
WINLINE_HeadDocType = TBDD_DOCEXPORT_PROFILE_RESULT.Value(5)
WINLINE_PostingType = TBDD_DOCEXPORT_PROFILE_RESULT.Value(6)
WINLINE_VARIABLE4 = TBDD_DOCEXPORT_PROFILE_RESULT.Value(7)
WINLINE_VARIABLE5 = TBDD_DOCEXPORT_PROFILE_RESULT.Value(8)
WINLINE_VARIABLE6 = TBDD_DOCEXPORT_PROFILE_RESULT.Value(9)
WINLINE_VARIABLE7 = TBDD_DOCEXPORT_PROFILE_RESULT.Value(10)
DOCEXPORT_PATH = TBDD_DOCEXPORT_PROFILE_RESULT.Value(11)
DOCEXPORT_FILENAME = TBDD_DOCEXPORT_PROFILE_RESULT.Value(12)
DOCEXPORT_FILENAME_PREVIEW = TBDD_DOCEXPORT_PROFILE_RESULT.Value(13)
DOCEXPORT_FILEEXTENSION = TBDD_DOCEXPORT_PROFILE_RESULT.Value(14)
DOCEXPORT_VERSIONING = TBDD_DOCEXPORT_PROFILE_RESULT.Value(15)
'Code block to get variables from table
SET TBDD_DOCEXPORT_CONFIG_VARSQL_RESULT = CWLStart.CurrentCompany.SearchRecord(TBDD_DOCEXPORT_CONFIG, TBDD_DOCEXPORT_CONFIG_VARSQL)
IF Err.Number <> 0 THEN
MSGBOX "Error Code: "& Err.Number & vbCrLf & _
"Error Description: "& Err.Description,,"ERROR: Variables from Database table "& TBDD_DOCEXPORT_CONFIG &" !"
Err.Clear
ELSE
IF TBDD_DOCEXPORT_CONFIG_VARSQL_RESULT = -1 Then
IF DebugMode = "Enabled" THEN
MSGBOX "No Rows found, SQL: "& TBDD_DOCEXPORT_CONFIG_VARSQL,,"DEBUG - Info: Variables from Database table "& TBDD_DOCEXPORT_CONFIG
END IF
ELSE
FOR LoopCounter = 1 TO TBDD_DOCEXPORT_CONFIG_VARSQL_RESULT.RowCount
IF DebugMode = "Enabled" THEN
MSGBOX "Name: " & TBDD_DOCEXPORT_CONFIG_VARSQL_RESULT.Value(5) & vbCrLf & _
"Type: " & TBDD_DOCEXPORT_CONFIG_VARSQL_RESULT.Value(6) & vbCrLf & _
"Value: "& TBDD_DOCEXPORT_CONFIG_VARSQL_RESULT.Value(7),,"DEBUG - Info: "& LoopCounter &" of "& TBDD_DOCEXPORT_CONFIG_VARSQL_RESULT.RowCount &" Variables from Database table "& TBDD_DOCEXPORT_CONFIG
END IF
ReplaceItems.ADD TBDD_DOCEXPORT_CONFIG_VARSQL_RESULT.Value(5),TBDD_DOCEXPORT_CONFIG_VARSQL_RESULT.Value(7)
TBDD_DOCEXPORT_CONFIG_VARSQL_RESULT.NextRecord
NEXT
END IF
END IF
'Replace PlaceHolder and invalid Characters
IF (DOCEXPORT_PATH <> "") THEN
ReplaceKeys = ReplaceItems.keys
For LoopCounter = 0 To ReplaceItems.Count -1
IF InStr(DOCEXPORT_PATH,ReplaceKeys(LoopCounter)) > 0 Then
DOCEXPORT_PATH = Replace(DOCEXPORT_PATH,ReplaceKeys(LoopCounter),ReplaceItems(ReplaceKeys(LoopCounter)))
END IF
Next
DOCEXPORT_PATH = Replace(Replace(Replace(Replace(Replace(Replace(DOCEXPORT_PATH,"/",ReplaceSpecialChar),"*",ReplaceSpecialChar),"?",ReplaceSpecialChar),"<",ReplaceSpecialChar),">",ReplaceSpecialChar),"|",ReplaceSpecialChar)
ReplaceItems.ADD "%DOCEXPORT_PATH%",DOCEXPORT_PATH
IF DebugMode = "Enabled" THEN
MSGBOX "DOCEXPORT_PATH: "& vbCrLf & DOCEXPORT_PATH & vbCrLf & vbCrLf & _
"ReplaceItems includes "& ReplaceItems.count &" Items.",,"DEBUG - Info: DOCEXPORT_PATH Variable AFTER replace routine"
END IF
END IF
'Replace PlaceHolder and invalid Characters
IF (DOCEXPORT_FILENAME <> "") THEN
ReplaceKeys = ReplaceItems.keys
For LoopCounter = 0 To ReplaceItems.Count -1
IF InStr(DOCEXPORT_FILENAME,ReplaceKeys(LoopCounter)) > 0 Then
DOCEXPORT_FILENAME = Replace(DOCEXPORT_FILENAME,ReplaceKeys(LoopCounter),ReplaceItems(ReplaceKeys(LoopCounter)))
END IF
Next
DOCEXPORT_FILENAME = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(DOCEXPORT_FILENAME,"\",ReplaceSpecialChar),"/",ReplaceSpecialChar),":",ReplaceSpecialChar),"*",ReplaceSpecialChar),"?",ReplaceSpecialChar),"<",ReplaceSpecialChar),">",ReplaceSpecialChar),"|",ReplaceSpecialChar)
ReplaceItems.ADD "%DOCEXPORT_FILENAME%",DOCEXPORT_FILENAME
IF DebugMode = "Enabled" THEN
MSGBOX "DOCEXPORT_FILENAME: "& vbCrLf & DOCEXPORT_FILENAME & vbCrLf & vbCrLf & _
"ReplaceItems includes "& ReplaceItems.count &" Items.",,"DEBUG - Info: DOCEXPORT_FILENAME Variable AFTER replace routine"
END IF
END IF
'Replace PlaceHolder and invalid Characters
IF (DOCEXPORT_FILENAME_PREVIEW <> "") THEN
ReplaceKeys = ReplaceItems.keys
For LoopCounter = 0 To ReplaceItems.Count -1
IF InStr(DOCEXPORT_FILENAME_PREVIEW,ReplaceKeys(LoopCounter)) > 0 Then
DOCEXPORT_FILENAME_PREVIEW = Replace(DOCEXPORT_FILENAME_PREVIEW,ReplaceKeys(LoopCounter),ReplaceItems(ReplaceKeys(LoopCounter)))
END IF
Next
DOCEXPORT_FILENAME_PREVIEW = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(DOCEXPORT_FILENAME_PREVIEW,"\",ReplaceSpecialChar),"/",ReplaceSpecialChar),":",ReplaceSpecialChar),"*",ReplaceSpecialChar),"?",ReplaceSpecialChar),"<",ReplaceSpecialChar),">",ReplaceSpecialChar),"|",ReplaceSpecialChar)
ReplaceItems.ADD "%DOCEXPORT_FILENAME_PREVIEW%",DOCEXPORT_FILENAME_PREVIEW
IF DebugMode = "Enabled" THEN
MSGBOX "DOCEXPORT_FILENAME_PREVIEW: "& vbCrLf & DOCEXPORT_FILENAME_PREVIEW & vbCrLf & vbCrLf & _
"ReplaceItems includes "& ReplaceItems.count &" Items.",,"DEBUG - Info: DOCEXPORT_FILENAME_PREVIEW Variable AFTER replace routine"
END IF
END IF
END IF
END IF
'########## main part ##########
'Check if all necessary export parameters are set.
IF ((DOCEXPORT_PATH <> "") AND (DOCEXPORT_FILENAME <> "") AND (DOCEXPORT_FILEEXTENSION <> "")) THEN
'Check if destination folder / folder strukture exists. If not, try to create.
IF NOT FileSystemObject.FolderExists(DOCEXPORT_PATH) THEN
strDir = FileSystemObject.GetAbsolutePathName(DOCEXPORT_PATH)
arrDirs = Split( strDir, "\" )
If Left( strDir, 2 ) = "\\" THEN
strDirBuild = "\\" & arrDirs(2) & "\" & arrDirs(3) & "\"
idxFirst = 4
Else
strDirBuild = arrDirs(0) & "\"
idxFirst = 1
End If
For idx = idxFirst to Ubound( arrDirs )
strDirBuild = FileSystemObject.BuildPath( strDirBuild, arrDirs(idx) )
If Not FileSystemObject.FolderExists( strDirBuild ) THEN
FileSystemObject.CreateFolder strDirBuild
End if
Next
END IF
'If DOCEXPORT_PATH exists, export file - including version tagging.
IF (FileSystemObject.FolderExists(DOCEXPORT_PATH)) THEN
DOCEXPORT_PATH_AND_FILENAME = DOCEXPORT_PATH & "\" & DOCEXPORT_FILENAME & "." &DOCEXPORT_FILEEXTENSION
IF (DOCEXPORT_VERSIONING = 1) THEN
IF (FileSystemObject.FileExists(DOCEXPORT_PATH_AND_FILENAME)) THEN
DO
DocVersion = DocVersion + 1
DOCEXPORT_PATH_AND_FILENAME = DOCEXPORT_PATH & "\" & DOCEXPORT_FILENAME & DocVersionSeparator & DocVersion & "." & DOCEXPORT_FILEEXTENSION
ReplaceItems.Remove("%DOCEXPORT_FILENAME%")
ReplaceItems.ADD "%DOCEXPORT_FILENAME%",DOCEXPORT_FILENAME & DocVersionSeparator & DocVersion & "." & DOCEXPORT_FILEEXTENSION
ReplaceItems.ADD "%DOCEXPORT_PATH_AND_FILENAME%",DOCEXPORT_PATH_AND_FILENAME
LOOP UNTIL (FileSystemObject.FileExists(DOCEXPORT_PATH_AND_FILENAME) = False)
END IF
END IF
IF DebugMode = "Enabled" THEN
MSGBOX "FINAL DOCEXPORT_PATH_AND_FILENAME: "& vbCrLf & DOCEXPORT_PATH_AND_FILENAME & vbCrLf & vbCrLf & _
"ReplaceItems includes "& ReplaceItems.count &" Items.",,"DEBUG - Info: Final document settings"
END IF
IF (DOCEXPORT_FILENAME_PREVIEW <> "") THEN
Formtitle = DOCEXPORT_FILENAME_PREVIEW
END IF
'In doc preview mode, there will be no export
ExportOutput DOCEXPORT_PATH_AND_FILENAME, 5, 1
ELSE
MSGBOX("ACHTUNG: Zielpfad für Export konnte nicht erstellt werden! Export wird abgebrochen.")
END IF
ELSEIF (DOCEXPORT_FILENAME_PREVIEW <> "") THEN
Formtitle = DOCEXPORT_FILENAME_PREVIEW
ELSE
'Missing Value in DOCEXPORT_PATH, DocTargetFileName or DOCEXPORT_FILEEXTENSION
WScript.Quit(1)
END IF
ResultValue = DOCEXPORT_PATH_AND_FILENAME
View Git Blame Copy Permalink