8
0

Anlage des Repos

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

3
README.MD Normal file
View File

@ -0,0 +1,3 @@
Hallo!
Willkommen in der Ecke der Skriptentwicklung!

View File

@ -0,0 +1,2 @@
Get-FsrmFileScreen
New-FsrmFileGroup -Name "Ransomware" IncludePattern @("*.k","*.encoderpass","*.key","*.ecc","*.ezz","*.exx","*.zzz","*.xyz","*.aaa","*.abc","*.ccc","*.vvv","*.xxx","*.ttt","*.micro","*.encrypted","*.locked","*.crypto","_crypt","*.crinf","*.r5a","*.xrtn","*.XTBL","*.crypt","*.R16M01D05","*.pzdc","*.good","*.LOL!","*.OMG!","*.RDM","*.RRK","*.encryptedRSA","*.crjoker","*.EnCiPhErEd","*.LeChiffre","*.keybtc@inbox_com","*.0x0","*.bleep","*.1999","*.vault","*.HA3","*.toxcrypt","*.magic","*.SUPERCRYPT","*.CTBL","*.CTB2","*.locky","HELPDECRYPT.TXT","HELP_YOUR_FILES.TXT","HELP_TO_DECRYPT_YOUR_FILES.txt","RECOVERY_KEY.txt","HELP_RESTORE_FILES.txt","HELP_RECOVER_FILES.txt","DECRYPT_INSTRUCTIONS.TXT","INSTRUCCIONES_DESCIFRADO.TXT","How_To_Recover_Files.txt","YOUR_FILES.HTML","YOUR_FILES.url","encryptor_raas_readme_liesmich.txt","Help_Decrypt.txt","DECRYPT_INSTRUCTION.TXT","HOW_TO_DECRYPT_FILES.TXT","ReadDecryptFilesHere.txt","Coin.Locker.txt","_secret_code.txt","About_Files.txt","Read.txt","ReadMe.txt","DECRYPT_ReadMe.TXT","DecryptAllFiles.txt","FILESAREGONE.TXT","IAMREADYTOPAY.TXT","HELLOTHERE.TXT","READTHISNOW!!!.TXT","SECRETIDHERE.KEY","IHAVEYOURSECRET.KEY","SECRET.KEY","HELPDECYPRT_YOUR_FILES.HTML","help_decrypt_your_files.html","HELP_TO_SAVE_FILES.txt","RECOVERY_FILES.txt","RECOVERY_FILE.TXT","RECOVERY_FILE*.txt","HowtoRESTORE_FILES.txt","HowtoRestore_FILES.txt","howto_recover_file.txt","restorefiles.txt","howrecover+*.txt","_how_recover.txt","recoveryfile*.txt","recoverfile*.txt","Howto_Restore_FILES.TXT","help_recover_instructions+*.txt","_Locky_recover_instructions.txt","*.trun","trun.key","*.fantom","DECRYPT_YOUR_FILES.HTML","Recovery+bwpnl.html","Recovery+bwpnl.txt","Recovery+bwpnl.png","_ReCoVeRy_orqit.html","_ReCoVeRy_orqit.png","_ReCoVeRy_orqit.txt","*.cerber","*.bart.zip","*.zepto","*@*")

View File

@ -0,0 +1,2 @@
Get-FsrmFileScreen
New-FsrmFileGroup -Name "Ransomware" IncludePattern @("*.k","*.encoderpass","*.key","*.ecc","*.ezz","*.exx","*.zzz","*.xyz","*.aaa","*.abc","*.ccc","*.vvv","*.xxx","*.ttt","*.micro","*.encrypted","*.locked","*.crypto","_crypt","*.crinf","*.r5a","*.xrtn","*.XTBL","*.crypt","*.R16M01D05","*.pzdc","*.good","*.LOL!","*.OMG!","*.RDM","*.RRK","*.encryptedRSA","*.crjoker","*.EnCiPhErEd","*.LeChiffre","*.keybtc@inbox_com","*.0x0","*.bleep","*.1999","*.vault","*.HA3","*.toxcrypt","*.magic","*.SUPERCRYPT","*.CTBL","*.CTB2","*.locky","HELPDECRYPT.TXT","HELP_YOUR_FILES.TXT","HELP_TO_DECRYPT_YOUR_FILES.txt","RECOVERY_KEY.txt","HELP_RESTORE_FILES.txt","HELP_RECOVER_FILES.txt","DECRYPT_INSTRUCTIONS.TXT","INSTRUCCIONES_DESCIFRADO.TXT","How_To_Recover_Files.txt","YOUR_FILES.HTML","YOUR_FILES.url","encryptor_raas_readme_liesmich.txt","Help_Decrypt.txt","DECRYPT_INSTRUCTION.TXT","HOW_TO_DECRYPT_FILES.TXT","ReadDecryptFilesHere.txt","Coin.Locker.txt","_secret_code.txt","About_Files.txt","Read.txt","ReadMe.txt","DECRYPT_ReadMe.TXT","DecryptAllFiles.txt","FILESAREGONE.TXT","IAMREADYTOPAY.TXT","HELLOTHERE.TXT","READTHISNOW!!!.TXT","SECRETIDHERE.KEY","IHAVEYOURSECRET.KEY","SECRET.KEY","HELPDECYPRT_YOUR_FILES.HTML","help_decrypt_your_files.html","HELP_TO_SAVE_FILES.txt","RECOVERY_FILES.txt","RECOVERY_FILE.TXT","RECOVERY_FILE*.txt","HowtoRESTORE_FILES.txt","HowtoRestore_FILES.txt","howto_recover_file.txt","restorefiles.txt","howrecover+*.txt","_how_recover.txt","recoveryfile*.txt","recoverfile*.txt","Howto_Restore_FILES.TXT","help_recover_instructions+*.txt","_Locky_recover_instructions.txt","*.trun","trun.key","*.fantom","DECRYPT_YOUR_FILES.HTML","Recovery+bwpnl.html","Recovery+bwpnl.txt","Recovery+bwpnl.png","_ReCoVeRy_orqit.html","_ReCoVeRy_orqit.png","_ReCoVeRy_orqit.txt","*.cerber","*.bart.zip","*.zepto","*@*","*.odin","*.aesir","*.uDz2j8mv")

View File

@ -0,0 +1,2 @@
Get-FsrmFileScreen
New-FsrmFileGroup -Name "Ransomware" IncludePattern @("*.k","*.encoderpass","*.key","*.ecc","*.ezz","*.exx","*.zzz","*.xyz","*.aaa","*.abc","*.ccc","*.vvv","*.xxx","*.ttt","*.micro","*.encrypted","*.locked","*.crypto","_crypt","*.crinf","*.r5a","*.xrtn","*.XTBL","*.crypt","*.R16M01D05","*.pzdc","*.good","*.LOL!","*.OMG!","*.RDM","*.RRK","*.encryptedRSA","*.crjoker","*.EnCiPhErEd","*.LeChiffre","*.keybtc@inbox_com","*.0x0","*.bleep","*.1999","*.vault","*.HA3","*.toxcrypt","*.magic","*.SUPERCRYPT","*.CTBL","*.CTB2","*.locky","HELPDECRYPT.TXT","HELP_YOUR_FILES.TXT","HELP_TO_DECRYPT_YOUR_FILES.txt","RECOVERY_KEY.txt","HELP_RESTORE_FILES.txt","HELP_RECOVER_FILES.txt","DECRYPT_INSTRUCTIONS.TXT","INSTRUCCIONES_DESCIFRADO.TXT","How_To_Recover_Files.txt","YOUR_FILES.HTML","YOUR_FILES.url","encryptor_raas_readme_liesmich.txt","Help_Decrypt.txt","DECRYPT_INSTRUCTION.TXT","HOW_TO_DECRYPT_FILES.TXT","ReadDecryptFilesHere.txt","Coin.Locker.txt","_secret_code.txt","About_Files.txt","Read.txt","ReadMe.txt","DECRYPT_ReadMe.TXT","DecryptAllFiles.txt","FILESAREGONE.TXT","IAMREADYTOPAY.TXT","HELLOTHERE.TXT","READTHISNOW!!!.TXT","SECRETIDHERE.KEY","IHAVEYOURSECRET.KEY","SECRET.KEY","HELPDECYPRT_YOUR_FILES.HTML","help_decrypt_your_files.html","HELP_TO_SAVE_FILES.txt","RECOVERY_FILES.txt","RECOVERY_FILE.TXT","RECOVERY_FILE*.txt","HowtoRESTORE_FILES.txt","HowtoRestore_FILES.txt","howto_recover_file.txt","restorefiles.txt","howrecover+*.txt","_how_recover.txt","recoveryfile*.txt","recoverfile*.txt","Howto_Restore_FILES.TXT","help_recover_instructions+*.txt","_Locky_recover_instructions.txt","*.trun","trun.key","*.fantom","DECRYPT_YOUR_FILES.HTML","Recovery+bwpnl.html","Recovery+bwpnl.txt","Recovery+bwpnl.png","_ReCoVeRy_orqit.html","_ReCoVeRy_orqit.png","_ReCoVeRy_orqit.txt","*.cerber","*.bart.zip","*.zepto","*@*")

View File

@ -0,0 +1,2 @@
Get-FsrmFileScreen
New-FsrmFileGroup -Name "Ransomware" IncludePattern @("*.k","*.encoderpass","*.key","*.ecc","*.ezz","*.exx","*.zzz","*.xyz","*.aaa","*.abc","*.ccc","*.vvv","*.xxx","*.ttt","*.micro","*.encrypted","*.locked","*.crypto","_crypt","*.crinf","*.r5a","*.xrtn","*.XTBL","*.crypt","*.R16M01D05","*.pzdc","*.good","*.LOL!","*.OMG!","*.RDM","*.RRK","*.encryptedRSA","*.crjoker","*.EnCiPhErEd","*.LeChiffre","*.keybtc@inbox_com","*.0x0","*.bleep","*.1999","*.vault","*.HA3","*.toxcrypt","*.magic","*.SUPERCRYPT","*.CTBL","*.CTB2","*.locky","HELPDECRYPT.TXT","HELP_YOUR_FILES.TXT","HELP_TO_DECRYPT_YOUR_FILES.txt","RECOVERY_KEY.txt","HELP_RESTORE_FILES.txt","HELP_RECOVER_FILES.txt","DECRYPT_INSTRUCTIONS.TXT","INSTRUCCIONES_DESCIFRADO.TXT","How_To_Recover_Files.txt","YOUR_FILES.HTML","YOUR_FILES.url","encryptor_raas_readme_liesmich.txt","Help_Decrypt.txt","DECRYPT_INSTRUCTION.TXT","HOW_TO_DECRYPT_FILES.TXT","ReadDecryptFilesHere.txt","Coin.Locker.txt","_secret_code.txt","About_Files.txt","Read.txt","ReadMe.txt","DECRYPT_ReadMe.TXT","DecryptAllFiles.txt","FILESAREGONE.TXT","IAMREADYTOPAY.TXT","HELLOTHERE.TXT","READTHISNOW!!!.TXT","SECRETIDHERE.KEY","IHAVEYOURSECRET.KEY","SECRET.KEY","HELPDECYPRT_YOUR_FILES.HTML","help_decrypt_your_files.html","HELP_TO_SAVE_FILES.txt","RECOVERY_FILES.txt","RECOVERY_FILE.TXT","RECOVERY_FILE*.txt","HowtoRESTORE_FILES.txt","HowtoRestore_FILES.txt","howto_recover_file.txt","restorefiles.txt","howrecover+*.txt","_how_recover.txt","recoveryfile*.txt","recoverfile*.txt","Howto_Restore_FILES.TXT","help_recover_instructions+*.txt","_Locky_recover_instructions.txt","*.trun","trun.key","*.fantom","DECRYPT_YOUR_FILES.HTML","Recovery+bwpnl.html","Recovery+bwpnl.txt","Recovery+bwpnl.png","_ReCoVeRy_orqit.html","_ReCoVeRy_orqit.png","_ReCoVeRy_orqit.txt","*.cerber","*.bart.zip","*.zepto","*@*","*.odin","*.aesir","*.uDz2j8mv")

View File

@ -0,0 +1 @@
PowerShell.exe -NoProfile -Command "& {Start-Process PowerShell.exe -ArgumentList '-NoProfile -ExecutionPolicy Bypass -File ""c:\scripts\block-smbshare.ps1""' -Verb RunAs}"

View File

@ -0,0 +1,18 @@
$logfile = "c:\Scripts\logfile.csv"
$events = Get-EventLog -LogName application -Source SRMSVC -After (get-date).AddMinutes(-10) | select ReplacementStrings -Unique
if ($events.count -gt 50)
{
stop-computer -force
}
else
{
foreach ($event in $events)
{
$sourceuser = $event.ReplacementStrings[0]
$smbsharepath = $event.ReplacementStrings[1]
$blockaccess = Get-SmbShare | where {$_.path -like $smbsharepath} | Block-SmbShareAccess -AccountName $sourceuser -Force
$log = "$sourceuser" + ";" + "$smbsharepath"
$log | add-content $logfile
}
}

View File

@ -0,0 +1,24 @@
clear
Push-Location $(Split-Path $Script:MyInvocation.MyCommand.Path)
$datei = Get-content .\20160829_Ransomware.txt
Remove-FsrmFileGroup -Name "Locky*"
Remove-FsrmFileScreen -Path E:\Test
$var = $datei.split(",")
for($i=0; $i -lt $var.Length; $i=$i+20){
$j = $i + 19
Write-Host "$i..$j"
$var.replace("""", $null)[$i..$j] -join ","
New-FsrmFileGroup -Name "Locky$i" -IncludePattern $var[$i..$j]
}
$array = @()
for($i=0; $i -lt $var.length; $i=$i+20){
$array += 'Locky' + $i
}
$Notification = New-FsrmAction -Type Email -MailTo Test@test.de -Subject FEHLER!!!!!! -Body [Violated File Group] located at: [Source File Path]. It was created by User: [Source Io Owner]. Ressource-Manager should block future accessing. -RunLimitInterval 120
$Notification1 = New-FsrmAction -Type Event -EventType Warning -Body "Alert text here" -RunlimitInterval 30
New-FsrmFileScreen -Path E:\Test -IncludeGroup $array -Notification $Notification,$Notification1

View File

@ -0,0 +1,854 @@
#PowerShell 3.0 Script
#This Script will check the Windows Event Log for unusual activity.
#Please use the "_Settings.ini"-File for configurations.
#Digital Data
#Ludwig-Rinn-Strasse 16
#35452 Heuchelheim
#Tel.: 0641 / 202360
#E-Mail: info@didalog.de
#Version Number: 1.2.0.0
#Version Date: 06.01.2017
#Requires Version 3.0
#-----------------------------------------------------------------------------------------------------#
######################################## check for arguments ##########################################
#-----------------------------------------------------------------------------------------------------#
Param (
[Parameter(Mandatory=$False,HelpMessage='Optional Parameter. By calling this Script with Parameter "-argOperationMode install", you can install and configure it. Default Value is "background".')]
[ValidateSet("install","background")]
[String]$argOperationMode="background"
) #end Param
Write-Host ""
Write-Host "DEBUG Info: Argument Call for OperationMode (-argOperationMode) is:"
Write-Host "DEBUG Info: $argOperationMode"
#-----------------------------------------------------------------------------------------------------#
###################################### add additional assemblys #######################################
#-----------------------------------------------------------------------------------------------------#
Add-Type -AssemblyName System.Windows.Forms -ErrorAction Stop
Add-Type -AssemblyName PresentationCore -ErrorAction Stop
Add-Type -AssemblyName PresentationFramework -ErrorAction Stop
#-----------------------------------------------------------------------------------------------------#
############################################ set variables ############################################
#-----------------------------------------------------------------------------------------------------#
Set-Variable -Scope Global -Name ScriptName -Value (($MyInvocation.MyCommand.Name) -split "\.")[0].ToString()
Set-Variable -Scope Global -Name ScriptPath -Value (Split-Path ($MyInvocation.MyCommand.Path))
Set-Variable -Scope Global -Name ConfigFile -Value (Get-ChildItem -Path "$ScriptPath" -Recurse -Filter "$ScriptName`_Settings.ini" -File -Force).FullName
Set-Variable -Scope Global -Name ConfigValues -Value $NULL
Set-Variable -Scope Global -Name Timestamp1 -Value $(Get-Date -Format 'ddMMyyyy')
Set-Variable -Scope Global -Name Timestamp2 -Value $(Get-Date -Format 'ddMMyyyy_HHmmss')
Set-Variable -Scope Global -Name Timestamp3 -Value $(Get-Date -Format 'ddMMyyyy_HHmmssffff')
Set-Variable -Scope Global -Name Timestamp4 -Value $(Get-Date -Format 'yyyyMMdd HH:mm:ss.fff')
Set-Variable -Scope Global -Name Counter1 -Value 0
Set-Variable -Scope Global -Name LogFile -Value "$ScriptName`_$Timestamp2.log"
Set-Variable -Scope Global -Name LogFileKeepTime -Value 60
Set-Variable -Scope Global -Name LogPath -Value $NULL
Set-Variable -Scope Global -Name LogPaths -Value $NULL
Set-Variable -Scope Global -Name Module -Value $NULL
Set-Variable -Scope Global -Name Modules -Value ("Write-LogFile","Read-ConfigFile","Remove-Item-withLogging","Start-windreamSession-withLogging","Restart-windreamClient-withLogging")
Set-Variable -Scope Global -Name ModuleOverrideSourcePath -Value $NULL
Set-Variable -Scope Global -Name ModuleDefaultSourcePath -Value $NULL
Set-Variable -Scope Global -Name ModuleHKLMRegistryPath -Value "HKLM:\SOFTWARE\Digital Data\Modules"
Set-Variable -Scope Global -Name ModuleHKCURegistryPath -Value "HKCU:\SOFTWARE\Digital Data\Modules"
Set-Variable -Scope Global -Name Item -Value $NULL
Set-Variable -Scope Global -Name Items -Value $NULL
Set-Variable -Scope Global -Name argOperationMode -Value $argOperationMode
Set-Variable -Scope Global -Name MessageBoxBody -Value $NULL
Set-Variable -Scope Global -Name MessageBoxTitle -Value $NULL
Set-Variable -Scope Global -Name MessageBoxButtonType -Value $NULL
Set-Variable -Scope Global -Name MessageBoxIcon -Value $NULL
Set-Variable -Scope Global -Name MessageBox -Value $NULL
Set-Variable -Scope Global -Name Result -Value $NULL
Set-Variable -Scope Global -Name UICultureForce -Value $($Host.CurrentUICulture.Name)
Set-Variable -Scope Global -Name UICultureData -Value @{"MessageBoxBody1_1"="Would you like to Test the windream Connectivity?";
"MessageBoxBody1_2"="If the Test fails, a restart of the windream client components will be attempted (";
"MessageBoxBody1_3"="Try(s) overall).";
"MessageBoxTitle1_1"="ScriptName: ";
"MessageBoxTitle1_2"="- Module/Section: pre Connection Test";
"MessageBoxBody2_1"="No windream Restart Try(s) needed, windream is still working!";
"MessageBoxBody3_1"="After";
"MessageBoxBody3_2"="windream Restart Try(s), windream is now working again!";
"MessageBoxBody4_1"="Its seems I have Dyscalculia, but windream is working, so everything is alright!";
"MessageBoxTitle2_1"="ScriptName: ";
"MessageBoxTitle2_2"="- Module/Section: Connection Test";
"MessageBoxBody5_1"="No windream Restart Try(s) possible, windream is still not working!";
"MessageBoxBody5_2"="Please contact your Administrator!";
"MessageBoxBody5_3"="He should check the LogFile:";
"MessageBoxBody6_1"="After ";
"MessageBoxBody6_2"=" windream Restart Try(s), windream is still not working!";
"MessageBoxBody6_3"="Please contact your Administrator!";
"MessageBoxBody6_4"="He should check the LogFile:"
"MessageBoxBody7_1"="Its seems I have Dyscalculia, but windream is not working, so nothing is alright!";
"MessageBoxBody7_2"="Please contact your Administrator!";
"MessageBoxBody7_3"="He should check the LogFile:";
"MessageBoxTitle3_1"="ScriptName: ";
"MessageBoxTitle3_2"="- Module/Section: Connection Test";}
#-----------------------------------------------------------------------------------------------------#
############################################ set functions ############################################
#-----------------------------------------------------------------------------------------------------#
Function Load-PowerShellModule {
<#
.SYNOPSIS
Function will load external - additional - PowerShell Modules into current PSSession.
.DESCRIPTION
By working with Modules, this Function is necessary to load external Modul Functions into the current PowerShell Session.
In a productive Enviroment it is recommanded to let this Function set the Registry Key in HKLM for the ModuleSourcePath.
In develepment and Test Enviroment it is possible, to work with distributed Folders with different Modules. Therefor the Parameter
"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
PowerShell V3
.REQUIREMENT Assembly
System.Windows.Forms, PresentationCore, PresentationFramework
.REQUIREMENT Variables
ModuleOverrideSourcePath, ModuleName, Path, Paths, PathTest, FileTest, Result
.REQUIREMENT Variables preSet
ScriptName, ScriptPath, ModuleDefaultSourcePath, Counter
.REQUIREMENT Functions
<NONE>
.VERSION
1.0.0.0 / 11.09.2016
.PARAMETER ModuleName
Give the Module Name, you want to load into the current PSSession (without File-Extension).
.PARAMETER ModuleOverrideSourcePath
Optional Parameter. By giving the ModuleOverrideSourcePath, Function will not check other Paths for the Function you want to load.
.PARAMETER ModuleFileExtension
Optional Parameter. Give the Module File-Extension (regular: "psm1") without a dot ("."), this is just for the checking routine, not the Import itself.')]
.PARAMETER Force
Optional Parameter. By using the Force Parameter, Module will be unload and reload.
.EXAMPLE
Load-PowerShellModule -ModuleName Write-LogFile -ModuleFileExtension psm1
.EXAMPLE
Load-PowerShellModule -ModuleName Write-LogFile -Force
.EXAMPLE
Load-PowerShellModule -ModuleName Write-LogFile -ModuleFileExtension psm1 -ModuleOverrideSourcePath D:\ScriptFiles\Modules
#>
[cmdletbinding()]
Param (
[Parameter(Position=0,Mandatory=$True,ValueFromPipeline=$True,HelpMessage='Give the ModuleName, you want to load into the current PSSession (without File-Extension)')]
[ValidateNotNullOrEmpty()]
[String]$ModuleName,
[Parameter(mandatory=$False,HelpMessage='Optional Parameter. By giving the ModuleOverrideSourcePath, Function will not check other Paths for the Function you want to load.')]
[ValidateNotNullOrEmpty()]
[String]$ModuleOverrideSourcePath,
[Parameter(mandatory=$False,HelpMessage='Optional Parameter. Give the Module File-Extension (regular: "psm1") without a dot ("."), this is just for the checking routine, not the Import itself.')]
[ValidateNotNullOrEmpty()]
[String]$ModuleFileExtension = "psm1",
[Parameter(mandatory=$False,HelpMessage='Optional Parameter. By using the Force Parameter, Module will be unload and reload.')]
[Switch]$Force
) #end param
Process {
#Clear Error Variable
$error.clear()
#If FileExtension was given, remove it! Because otherwise "Import-Module" Function will have trouble importing.
$ModuleName = $ModuleName.Replace(".$ModuleFileExtension","")
Write-Host "DEBUG Info - Load-PowerShellModule: You want to load Module $ModuleName"
#Try this if $ModuleOverrideSourcePath was given by calling the function
IF ((([String]::IsNullOrWhiteSpace($ModuleOverrideSourcePath)) -ne $true) -and (([String]::IsNullOrEmpty($ModuleOverrideSourcePath)) -ne $true)) {
Write-Host ""
Write-Host "DEBUG Info - Load-PowerShellModule: Function has been called with 'ModuleOverrideSourcePath' Parameter input!"
Write-Host "DEBUG Info - Load-PowerShellModule: Testing for existence: $ModuleOverrideSourcePath\$ModuleName.$ModuleFileExtension"
$PathTest = Test-Path -Path "$ModuleOverrideSourcePath\$ModuleName.$ModuleFileExtension" -PathType Leaf
IF ($PathTest -eq $true) {
Write-Host "DEBUG Info - Load-PowerShellModule: $ModuleOverrideSourcePath and ModuleName seems to exist."
Write-Host "DEBUG Info - Load-PowerShellModule: Trying to import Module: $ModuleName.$ModuleFileExtension"
Try {
$Result = Import-Module $ModuleOverrideSourcePath\$ModuleName -Verbose -DisableNameChecking -Scope Global -Force:$Force -PassThru -ErrorVariable Error -ErrorAction SilentlyContinue
IF ("$Result" -eq "$ModuleName") {
Write-Host "DEBUG Info - Load-PowerShellModule: Successfully loaded Module: $ModuleName.$ModuleFileExtension"
Return $True
} #end if
ELSE {
Write-Error "DEBUG Info - Load-PowerShellModule: Unsuccessfully loaded Module: $ModuleName.$ModuleFileExtension"
Return $False
} #end else
} #end try
Catch {
Write-Host "DEBUG Info - Load-PowerShellModule: Error while importing the Module:"
Write-Host "DEBUG Info - Load-PowerShellModule: $ModuleName"
Write-Host $Error
Return $False
} #end catch
} #end if
ELSE {
Write-Host "DEBUG Info - Load-PowerShellModule: ModuleOverrideSourcePath and/or ModuleName seems not to exist."
Write-Host "DEBUG Info - Load-PowerShellModule: Cannot load Module, please check your input!"
Return $False
} #end else
} #end if
#If $ModuleOverrideSourcePath was not given, try to find a matching folder
ELSE {
Write-Host ""
Write-Host "DEBUG Info - Load-PowerShellModule: Function has been called without 'ModuleOverrideSourcePath' Parameter input!"
Write-Host "DEBUG Info - Load-PowerShellModule: Trying to find Module Files on some Places of this Computer."
#Set dynamic Array for locations Modul Path could be, even for some testing.
#The first value of the array is just a dummy and will never be used -but keep it for the array value starting with 0!
[System.Collections.ArrayList]$Paths = @()
Write-Host ""
$Paths.Add("$env:systemroot\") | Out-Null
IF (([String]::IsNullOrEmpty($ModuleDefaultSourcePath)) -or ([String]::IsNullOrWhiteSpace($ModuleDefaultSourcePath))) {
Write-Host "DEBUG Info - Load-PowerShellModule: ModuleDefaultSourcePath was not set! That could be a normal behavior in productive enviroment!"
} #end if
ELSE {
Write-Host "DEBUG Info - Load-PowerShellModule: Possible Path (1): $ModuleDefaultSourcePath" -ErrorAction SilentlyContinue
$Paths.Add("$ModuleDefaultSourcePath") | Out-Null
} #end else
IF ([String]::IsNullOrEmpty($ScriptPath) -or ([String]::IsNullOrWhiteSpace($ScriptPath))) {
Write-Host "DEBUG Info - Load-PowerShellModule: ScriptPath is invalid! That is terrifying! How could that be???"
} #end if
ELSE {
Write-Host "DEBUG Info - Load-PowerShellModule: Possible Path (2): $ScriptPath" -ErrorAction SilentlyContinue
$Paths.Add("$ScriptPath") | Out-Null
Write-Host "DEBUG Info - Load-PowerShellModule: Possible Path (3): $($ScriptPath+"\Module")" -ErrorAction SilentlyContinue
$Paths.Add("$($ScriptPath+"\Module")") | Out-Null
Write-Host "DEBUG Info - Load-PowerShellModule: Possible Path (4): $($ScriptPath+"\Modules")" -ErrorAction SilentlyContinue
$Paths.Add("$($ScriptPath+"\Modules")") | Out-Null
} #end else
IF (([String]::IsNullOrEmpty((Get-Item $ScriptPath).Parent.FullName)) -or ([String]::IsNullOrWhiteSpace((Get-Item $ScriptPath).Parent.FullName))) {
Write-Host "DEBUG Info - Load-PowerShellModule: ScriptPath has no Parent Folders!"
} #end if
ELSE {
Write-Host "DEBUG Info - Load-PowerShellModule: Possible Path (5): $((Get-Item $ScriptPath).Parent.FullName)" -ErrorAction SilentlyContinue
$Paths.Add("$((Get-Item $ScriptPath).Parent.FullName)") | Out-Null
Write-Host "DEBUG Info - Load-PowerShellModule: Possible Path (6): $(((Get-Item $ScriptPath).Parent.FullName)+"\Module")" -ErrorAction SilentlyContinue
$Paths.Add("$(((Get-Item $ScriptPath).Parent.FullName)+"\Module")") | Out-Null
Write-Host "DEBUG Info - Load-PowerShellModule: Possible Path (7): $(((Get-Item $ScriptPath).Parent.FullName)+"\Modules")" -ErrorAction SilentlyContinue
$Paths.Add("$(((Get-Item $ScriptPath).Parent.FullName)+"\Modules")") | Out-Null
} #end else
IF (([String]::IsNullOrEmpty($((Get-ItemProperty -Path "$ModuleHKLMRegistryPath" -Name ModuleSourcePath -ErrorAction SilentlyContinue).ModuleSourcePath))) -or ([String]::IsNullOrWhiteSpace($((Get-ItemProperty -Path "$ModuleHKLMRegistryPath" -Name ModuleSourcePath -ErrorAction SilentlyContinue).ModuleSourcePath)))) {
Write-Host "DEBUG Info - Load-PowerShellModule: ModuleSourcePath was not set to Windows Registry (HKLM)!"
} #end if
ELSE {
Write-Host "DEBUG Info - Load-PowerShellModule: Possible Path (8): $((Get-ItemProperty -Path "$ModuleHKLMRegistryPath" -Name ModuleSourcePath -ErrorAction SilentlyContinue).ModuleSourcePath)" -ErrorAction SilentlyContinue
$Paths.Add("$((Get-ItemProperty -Path "$ModuleHKLMRegistryPath" -Name ModuleSourcePath -ErrorAction SilentlyContinue).ModuleSourcePath)") | Out-Null
} #end else
IF (([String]::IsNullOrEmpty($((Get-ItemProperty -Path "$ModuleHKCURegistryPath" -Name ModuleSourcePath -ErrorAction SilentlyContinue).ModuleSourcePath))) -or ([String]::IsNullOrWhiteSpace($((Get-ItemProperty -Path "$ModuleHKCURegistryPath" -Name ModuleSourcePath -ErrorAction SilentlyContinue).ModuleSourcePath)))) {
Write-Host "DEBUG Info - Load-PowerShellModule: ModuleSourcePath was not set to Windows Registry (HKCU)!"
} #end if
ELSE {
Write-Host "DEBUG Info - Load-PowerShellModule: Possible Path (8): $((Get-ItemProperty -Path "$ModuleHKCURegistryPath" -Name ModuleSourcePath -ErrorAction SilentlyContinue).ModuleSourcePath)" -ErrorAction SilentlyContinue
$Paths.Add("$((Get-ItemProperty -Path "$ModuleHKCURegistryPath" -Name ModuleSourcePath -ErrorAction SilentlyContinue).ModuleSourcePath)") | Out-Null
} #end else
[Int]$Counter = 0
[String]$ModuleSourcePath = $Null
#Loop for multiple Pathtests - for each Path, where psm1 files could be
DO {
$Counter++
Write-Host ""
Write-Host "DEBUG Info - Load-PowerShellModule: Testing mutiple Paths ( $Counter of"($($Paths.Count)-1)") for existence, now testing:"
Write-Host "DEBUG Info - Load-PowerShellModule: $($Paths[$Counter])"
IF ($($Paths[$Counter]) -gt $Null) {
$PathTest = Test-Path $($Paths[$Counter]) -ErrorAction SilentlyContinue
IF ($PathTest -eq $true) {
Write-Host "DEBUG Info - Load-PowerShellModule: Yes, Path seems to exist."
Write-Host "DEBUG Info - Load-PowerShellModule: Lets check, if there are any Module Files, in it."
$FileTest = Get-ChildItem -Path $($Paths[$Counter]) -Filter *.$ModuleFileExtension
IF ($($FileTest.count) -gt 0) {
Write-Host "DEBUG Info - Load-PowerShellModule: Found $($FileTest.count) psm1 Module Files in Path!"
Set-Variable -Name ModuleSourcePath -Value $($Paths[$Counter]) -Scope local
} #end if
ELSE {
Write-Host "DEBUG Info - Load-PowerShellModule: Found no $ModuleFileExtension Module Files in Path!"
} #end else
} #end if
ELSE {
Write-Host "DEBUG Info - Load-PowerShellModule: No, Path seems not to exist."
} #end else
} #end if
ELSE {
Write-Host "DEBUG Info - Load-PowerShellModule: Path seems to be invalid!"
} #end else
} #end do
UNTIL ($Counter -ge ($($Paths.Count)-1) -or ($ModuleSourcePath -eq $($Paths[$Counter])))
IF ($ModuleSourcePath -eq $($Paths[$Counter])) {
Write-Host ""
Write-Host "DEBUG Info - Load-PowerShellModule: Trying to import Module: $ModuleName.$ModuleFileExtension"
Try {
$Result = Import-Module $ModuleSourcePath\$ModuleName -Verbose -DisableNameChecking -Scope Global -Force:$Force -PassThru -ErrorVariable Error -ErrorAction SilentlyContinue
IF ("$Result" -eq "$ModuleName") {
Write-Host "DEBUG Info - Load-PowerShellModule: Successfully loaded Module: $ModuleName.$ModuleFileExtension"
Return $true
} #end if
ELSE {
Write-Error "DEBUG Info - Load-PowerShellModule: Unsuccessfully loaded Module: $ModuleName.$ModuleFileExtension"
Return $False
} #end else
} #end try
Catch {
Write-Host ""
Write-Host "DEBUG Info - Load-PowerShellModule: Loading Module: $ModuleName went wrong."
Write-Host "DEBUG Info - Load-PowerShellModule: Exiting Script, because of this error!"
Write-Host $Error
Return $False
exit
} #end catch
} #end if
ELSE {
Write-Host ""
Write-Host "DEBUG Info - Load-PowerShellModule: Cant locate Module Files automaticlly!"
Write-Host "DEBUG Info - Load-PowerShellModule: Please select Folder in Dialog."
#Prepare Folder Browser Dialog, to choose the Directory with the .psm1 Files.
$FolderBrowserDialog = New-Object System.Windows.Forms.FolderBrowserDialog
$FolderBrowserDialog.Rootfolder = "Desktop"
$FolderBrowserDialog.Description = "Please, choose the Folder, where the Module ""$ModuleName.$ModuleFileExtension"" is stored."
$FolderBrowserDialog.SelectedPath = "$ScriptPath"
$FolderBrowserDialog.ShowNewFolderButton = $true
DO {
#Now show the Folder Browser, if neccessary in a loop
$FolderBrowserDialogShow = $FolderBrowserDialog.ShowDialog()
#By pressing the OK Button..
If ($FolderBrowserDialogShow -eq "OK") {
#Save selected folder path in the variable
$ModuleSourcePath = ($FolderBrowserDialog.SelectedPath)
Write-Host ""
Write-Host "DEBUG Info - Load-PowerShellModule: You choose: $ModuleSourcePath"
Write-Host "DEBUG Info - Load-PowerShellModule: ...testing, if Module ""$ModuleName.$ModuleFileExtension"" can be found there."
$PathTest = (Test-Path $ModuleSourcePath\$ModuleName.$ModuleFileExtension)
IF ($PathTest -eq $True) {
Write-Host "DEBUG Info - Load-PowerShellModule: Module seems to exist, in the selected Folder."
Write-Host "DEBUG Info - Load-PowerShellModule: Now trying to load Module: $ModuleName.$ModuleFileExtension"
Try {
$Result = Import-Module $ModuleSourcePath\$ModuleName -Verbose -DisableNameChecking -Scope Global -Force:$Force -PassThru -ErrorVariable Error -ErrorAction SilentlyContinue
IF ("$Result" -eq "$ModuleName") {
$MessageBoxBody = "Module: $ModuleName.$ModuleFileExtension - successsfully loaded into current PSSession!"
$MessageBoxTitle = "ScriptName: $ScriptName - Module/Section: Load-PowerShellModule"
$MessageBoxButtonType = "OK"
$MessageBoxIcon = "Information"
$MessageBox = [Windows.Forms.MessageBox]::Show($MessageBoxBody,$MessageBoxTitle,$MessageBoxButtonType,$MessageBoxIcon) | Out-Null
} #end if
ELSE {
$MessageBoxBody = "Module: $ModuleName.$ModuleFileExtension - cannot load into current PSSession!"
$MessageBoxTitle = "ScriptName: $ScriptName - Module/Section: Load-PowerShellModule"
$MessageBoxButtonType = "OK"
$MessageBoxIcon = "Warning"
$MessageBox = [Windows.Forms.MessageBox]::Show($MessageBoxBody,$MessageBoxTitle,$MessageBoxButtonType,$MessageBoxIcon) | Out-Null
} #end else
} #end try
Catch {
Write-Host ""
Write-Host "DEBUG Info - Load-PowerShellModule: Loading Module: $ModuleName.$ModuleFileExtension went wrong."
Write-Host "DEBUG Info - Load-PowerShellModule: Exiting Script, because of this error!"
Write-Host $Error
exit
} #end catch
} #end if
ELSE {
Write-Host "DEBUG Info - Load-PowerShellModule: Module seems not to exist, in the selected Folder."
Write-Host "DEBUG Info - Load-PowerShellModule: Please, select another one! ...this Time the right!"
$MessageBoxBody = "Module seems not to exist, in the selected Folder! Please, select another one!"
$MessageBoxTitle = "ScriptName: $ScriptName - Module/Section: Load-PowerShellModule"
$MessageBoxButtonType = "OK"
$MessageBoxIcon = "Warning"
$MessageBox = [Windows.Forms.MessageBox]::Show($MessageBoxBody,$MessageBoxTitle,$MessageBoxButtonType,$MessageBoxIcon) | Out-Null
} #end else
} #end if
#If you didnt pressed the OK Button..
Else {
Write-Host ""
Write-Host "DEBUG Info - Load-PowerShellModule: Operation cancelled by user."
Write-Host "DEBUG Info - Load-PowerShellModule: Exiting Script, because of this!"
exit
} #end else
} #end do
#Variable "$?" is $true when last operation was ok
UNTIL ((($PathTest -eq $True) -and ($? -eq $true)) -or ($FolderBrowserDialogShow -eq "Cancel"))
IF ($ModuleSourcePath -gt $Null) {
Write-Host ""
Write-Host "DEBUG Info - Load-PowerShellModule: Should ModuleSourcePath written to Windows Registry?"
$MessageBoxBody = "Would you like to save the ModulePath to the Windows Registry?"
$MessageBoxTitle = "ScriptName: $ScriptName - Module/Section: Load-PowerShellModule"
$MessageBoxButtonType = "YesNo"
$MessageBoxIcon = "Question"
$MessageBox = [Windows.Forms.MessageBox]::Show($MessageBoxBody,$MessageBoxTitle,$MessageBoxButtonType,$MessageBoxIcon)
IF ($MessageBox -eq 'Yes') {
$PathTest = (Test-Path -Path "$ModuleHKLMRegistryPath")
$MessageBox = $NULL
IF ($PathTest -eq $False) {
Write-Host "DEBUG Info - Load-PowerShellModule: Registry Key seems not to exist."
Write-Host "DEBUG Info - Load-PowerShellModule: Trying to write ModuleSourcepath to HKLM."
Try {
New-Item -Path "$ModuleHKLMRegistryPath" -Force -ErrorVariable Error -ErrorAction Stop | Out-Null
New-ItemProperty -Path "$ModuleHKLMRegistryPath" -Name ModuleSourcePath -Value $ModuleSourcePath -ErrorVariable Error -ErrorAction Stop | Out-Null
$env:PSModulePath = $env:PSModulePath + ";" + "$ModuleSourcePath"
} #end try
Catch {
Write-Host $Error
$MessageBoxBody = "Could not save ModuleSourcePath to Windows Registry! Check your access rights! To bypass this issue you can write the ModuleSourcePath to User Registry (HKCU). Would you?"
$MessageBoxTitle = "ScriptName: $ScriptName - Module/Section: Load-PowerShellModule"
$MessageBoxButtonType = "YesNo"
$MessageBoxIcon = "Question"
$MessageBox = [Windows.Forms.MessageBox]::Show($MessageBoxBody,$MessageBoxTitle,$MessageBoxButtonType,$MessageBoxIcon)
} #end catch
} #end if
ELSEIF ($PathTest -eq $True) {
Write-Host "DEBUG Info - Load-PowerShellModule: Registry Key seems to exist."
Write-Host "DEBUG Info - Load-PowerShellModule: Trying to write ModuleSourcepath to HKLM."
Try {
Set-ItemProperty -Path "$ModuleHKLMRegistryPath" -Name ModuleSourcePath -Value $ModuleSourcePath -ErrorVariable Error -ErrorAction Stop | Out-Null
} #end try
Catch {
Write-Host $Error
$MessageBoxBody = "Could not save ModuleSourcePath to Windows Registry! Check your access rights! To Bypass Error: Write ModuleSource Path to User Registry (HKCU)?"
$MessageBoxTitle = "ScriptName: $ScriptName - Module/Section: Load-PowerShellModule"
$MessageBoxButtonType = "YesNo"
$MessageBoxIcon = "Question"
$MessageBox = [Windows.Forms.MessageBox]::Show($MessageBoxBody,$MessageBoxTitle,$MessageBoxButtonType,$MessageBoxIcon)
} #end catch
} #end elseif
ELSE {
Write-Host "DEBUG Info - Load-PowerShellModule: Something went wrong, by getting the ModuleSourcePath!"
Write-Host "DEBUG Info - Load-PowerShellModule: Exiting Script, because of this!"
exit
} #end else
#Block for trying to write the ModuleSourcePath to the User Registry, if System Registry failed.
IF ($MessageBox -eq 'Yes') {
$PathTest = (Test-Path -Path "$ModuleHKCURegistryPath")
$MessageBox = $NULL
IF ($PathTest -eq $False) {
Write-Host "DEBUG Info - Load-PowerShellModule: Registry Key seems not to exist."
Write-Host "DEBUG Info - Load-PowerShellModule: Trying to write ModuleSourcepath to HKCU."
Try {
New-Item -Path "$ModuleHKCURegistryPath" -Force -ErrorVariable Error -ErrorAction Stop | Out-Null
New-ItemProperty -Path "$ModuleHKCURegistryPath" -Name ModuleSourcePath -Value $ModuleSourcePath -ErrorAction Stop | Out-Null
$env:PSModulePath = $env:PSModulePath + ";" + "$ModuleSourcePath"
} #end try
Catch {
Write-Host $Error
$MessageBoxBody = "Could not save ModuleSourcePath to Windows Registry! Not even to User Registry! Check your access rights! Exiting now.."
$MessageBoxTitle = "ScriptName: $ScriptName - Module/Section: Load-PowerShellModule"
$MessageBoxButtonType = "OK"
$MessageBoxIcon = "Warning"
$MessageBox = [Windows.Forms.MessageBox]::Show($MessageBoxBody,$MessageBoxTitle,$MessageBoxButtonType,$MessageBoxIcon)
exit
} #end catch
} #end if
ELSEIF ($PathTest -eq $True) {
Write-Host "DEBUG Info - Load-PowerShellModule: Registry Key seems to exist."
Write-Host "DEBUG Info - Load-PowerShellModule: Trying to write ModuleSourcepath to HKCU."
Try {
Set-ItemProperty -Path "$ModuleHKCURegistryPath" -Name ModuleSourcePath -Value $ModuleSourcePath -ErrorVariable Error -ErrorAction Stop | Out-Null
} #end try
Catch {
Write-Host $Error
$MessageBoxBody = "Could not save ModuleSourcePath to Windows Registry! Not even to User Registry! Check your access rights! Exiting now.."
$MessageBoxTitle = "ScriptName: $ScriptName - Module/Section: Load-PowerShellModule"
$MessageBoxButtonType = "OK"
$MessageBoxIcon = "Warning"
$MessageBox = [Windows.Forms.MessageBox]::Show($MessageBoxBody,$MessageBoxTitle,$MessageBoxButtonType,$MessageBoxIcon)
exit
} #end catch
} #end elseif
ELSE {
Write-Host "DEBUG Info - Load-PowerShellModule: Something went wrong, by getting the ModuleSourcePath!"
Write-Host "DEBUG Info - Load-PowerShellModule: Exiting Script, because of this!"
exit
} #end else
} #end if
} #end if
ELSE {
Write-Host "DEBUG Info - Load-PowerShellModule: You choose, not to save the ModuleSourcePath to the Windows Registry!"
$MessageBoxBody = "You choose, not to save the ModuleSourcePath to the Windows Registry!"
$MessageBoxTitle = "ScriptName: $ScriptName - Module/Section: Load-PowerShellModule"
$MessageBoxButtonType = "OK"
$MessageBoxIcon = "Warning"
$MessageBox = [Windows.Forms.MessageBox]::Show($MessageBoxBody,$MessageBoxTitle,$MessageBoxButtonType,$MessageBoxIcon)
} #end else
} #end if
ELSE {
Write-Host "DEBUG Info - Load-PowerShellModule: Something went wrong, by getting the ModuleSourcePath!"
Write-Host "DEBUG Info - Load-PowerShellModule: Exiting Script, because of this!"
exit
} #end else
} #end else
} #end else
} #end process
} #end function
#-----------------------------------------------------------------------------------------------------#
########################################### preparing part ############################################
#-----------------------------------------------------------------------------------------------------#
#Clear Console Content
Clear-Host
#Load external Modules - use Force ( -Force) Parameter, to reload in every run
FOREACH ($Module in $Modules) {
$Result = Load-PowerShellModule -ModuleName $Module -Force
IF ($Result -eq $False) {
Write-Host "DEBUG Info: Module: $Module was not succesful been loaded!"
Write-Host "DEBUG Info: Please load the Module and try again, running this Function/Module!"
Write-Host "DEBUG Info: Exiting, because of this Issue."
Write-Host $Error
EXIT
} #end if
} #end foreach
#Read ConfigFile, to get all values
Set-Variable -Scope Global -Name ConfigValues -Value (Read-ConfigFile -ConfigFile $ConfigFile) -Force
#Allocate Variable Values, depending on the read ConfigFile
Set-Variable -Scope Global -Name LogPaths -Value (Read-ConfigFile -ConfigLabel LogPath) -Force
Set-Variable -Scope Global -Name LogFileKeepTime -Value (Read-ConfigFile -ConfigLabel LogFileKeepTime) -Force
#Load language File(s), if load fails -> preset Hashtable from the "set variables" section, will be used.
Write-Host "DEBUG Info: Current UICulture is: $($Host.CurrentUICulture.Name), the forced UICulture is: $UICultureForce"
Import-LocalizedData -BaseDirectory (Join-Path -Path $ScriptPath -ChildPath Localized) -BindingVariable UICultureData -FileName UICultureData.psd1 -ErrorAction SilentlyContinue -UICulture $UICultureForce
#-----------------------------------------------------------------------------------------------------#
############################################# main part ###############################################
#-----------------------------------------------------------------------------------------------------#
Write-Logfile -LogLine " "
Write-Logfile -LogLine "********************************************************************************"
Write-Logfile -LogLine "Program Startup: $ScriptName on $env:computername,"
Write-Logfile -LogLine "from Account $env:USERDOMAIN\$env:USERNAME."
Write-Logfile -LogLine "********************************************************************************"
#If Argument Call was "interactive"
IF ($argOperationMode -like "install") {
Write-LogFile -LogLine " "
Write-LogFile -LogLine "Running in install mode..."
Write-Host "DEBUG Info: Showing MSGBox, which asks if Script should be installed."
$MessageBoxBody = $UICultureData.MessageBoxBody1_1 +"`r`n" + "`r`n"+ $UICultureData.MessageBoxBody1_2 + $windreamClientRestartTrys + " " + $UICultureData.MessageBoxBody1_3
$MessageBoxTitle = $UICultureData.MessageBoxTitle1_1 + " " + $ScriptName + " " + $UICultureData.MessageBoxTitle1_2
$MessageBoxButtonType = "YesNo"
$MessageBoxIcon = "Question"
$MessageBox = [Windows.Forms.MessageBox]::Show($MessageBoxBody,$MessageBoxTitle,$MessageBoxButtonType,$MessageBoxIcon)
#If Argument Call was "interactive" and first Question was answerd with "Yes" or Argument Call was "background" (which is default)
IF (($argOperationMode -like "install") -and ($MessageBox -eq 'Yes')) {
$MessageBoxBody = "installation aborted"
$MessageBoxTitle = $UICultureData.MessageBoxTitle1_1 + " " + $ScriptName + " " + $UICultureData.MessageBoxTitle1_2
$MessageBoxButtonType = "YesNo"
$MessageBoxIcon = "Question"
$MessageBox = [Windows.Forms.MessageBox]::Show($MessageBoxBody,$MessageBoxTitle,$MessageBoxButtonType,$MessageBoxIcon)
$objForm = New-Object System.Windows.Forms.OpenFileDialog
$objForm.InitialDirectory = $Scriptpath
$objForm.Filter = "All Files (*.*)|*.*"
$objForm.Title = "Select Sourcefile, please!"
$Show = $objForm.ShowDialog()
If ($Show -eq "OK") {
Return $objForm.FileName
}
Else {
Write-Error "Operation cancelled by user."
}
} #end if
#If Argument Call was "interactive" and first Question was answerd with "No" or just aborted it
ELSE {
Write-Logfile -LogLine " "
Write-Logfile -LogLine "windream Connectivity Test was aborted by User..."
} #end else
} #end if
#If Argument Call wasnt "install"
ELSE {
Write-LogFile -LogLine " "
Write-LogFile -LogLine "Running in background mode..."
} #end else
Write-Logfile -LogLine " "
Write-Logfile -LogLine "--------------------------------------------------------------------------------"
Write-Logfile -LogLine "Checking for old LogFiles."
Write-Logfile -LogLine "--------------------------------------------------------------------------------"
Remove-Item-withLogging -Path $LogPath -FileKeepTime $LogFileKeepTime -FileBaseName $ScriptName
Write-Logfile -LogLine " "
Write-Logfile -LogLine "********************************************************************************"
Write-Logfile -LogLine "Program Completed: $ScriptName on $env:computername,"
Write-Logfile -LogLine "from Account $env:USERDOMAIN\$env:USERNAME."
Write-Logfile -LogLine "********************************************************************************"
#-----------------------------------------------------------------------------------------------------#
########################################### finishing part ############################################
#-----------------------------------------------------------------------------------------------------#
Remove-Variable -Name ScriptName -Force -ErrorAction SilentlyContinue
Remove-Variable -Name ScriptPath -Force -ErrorAction SilentlyContinue
Remove-Variable -Name ConfigFile -Force -ErrorAction SilentlyContinue
Remove-Variable -Name ConfigValues -Force -ErrorAction SilentlyContinue
Remove-Variable -Name Timestamp1 -Force -ErrorAction SilentlyContinue
Remove-Variable -Name Timestamp2 -Force -ErrorAction SilentlyContinue
Remove-Variable -Name Timestamp3 -Force -ErrorAction SilentlyContinue
Remove-Variable -Name Timestamp4 -Force -ErrorAction SilentlyContinue
Remove-Variable -Name Counter1 -Force -ErrorAction SilentlyContinue
Remove-Variable -Name LogFile -Force -ErrorAction SilentlyContinue
Remove-Variable -Name LogFileKeepTime -Force -ErrorAction SilentlyContinue
Remove-Variable -Name LogPath -Force -ErrorAction SilentlyContinue
Remove-Variable -Name LogPaths -Force -ErrorAction SilentlyContinue
Remove-Variable -Name Module -Force -ErrorAction SilentlyContinue
Remove-Variable -Name Modules -Force -ErrorAction SilentlyContinue
Remove-Variable -Name ModuleOverrideSourcePath -Force -ErrorAction SilentlyContinue
Remove-Variable -Name ModuleDefaultSourcePath -Force -ErrorAction SilentlyContinue
Remove-Variable -Name ModuleHKLMRegistryPath -Force -ErrorAction SilentlyContinue
Remove-Variable -Name ModuleHKCURegistryPath -Force -ErrorAction SilentlyContinue
Remove-Variable -Name Item -Force -ErrorAction SilentlyContinue
Remove-Variable -Name Items -Force -ErrorAction SilentlyContinue
Remove-Variable -Name argOperationMode -Force -ErrorAction SilentlyContinue
Remove-Variable -Name MessageBoxBody -Force -ErrorAction SilentlyContinue
Remove-Variable -Name MessageBoxTitle -Force -ErrorAction SilentlyContinue
Remove-Variable -Name MessageBoxButtonType -Force -ErrorAction SilentlyContinue
Remove-Variable -Name MessageBoxIcon -Force -ErrorAction SilentlyContinue
Remove-Variable -Name MessageBox -Force -ErrorAction SilentlyContinue
Remove-Variable -Name Result -Force -ErrorAction SilentlyContinue
Remove-Variable -Name UICultureForce -Force -ErrorAction SilentlyContinue
Remove-Variable -Name UICultureData -Force -ErrorAction SilentlyContinue
$error.clear()

View File

@ -0,0 +1,45 @@
@ECHO OFF
TITLE DIGITAL DATA - Run all files in directory with current permissions
ECHO -
ECHO Batch Script
ECHO Run all files in directory with current permissions
ECHO -
ECHO Digital Data
ECHO Ludwig-Rinn-Strasse 16
ECHO 35452 Heuchelheim
ECHO Tel.: 0641 / 202360
ECHO E-Mail: info@didalog.de
ECHO -
ECHO Version 1.0.0.0
ECHO Date: 13.08.2015
ECHO -
ECHO Program Startup %date% at %time:~0,8% oclock, on %computername%.
REM --------------------------------------------------------------
REM ------------------------set variables-------------------------
REM --------------------------------------------------------------
setlocal enableextensions
SET DIRECTORY="%cd%"
SET FILEEXTENSION=*.ps1
SET COUNT=0
REM --------------------------------------------------------------
REM ---------------------Program 1 / Script 1---------------------
REM --------------------------------------------------------------
FOR /F "tokens=*" %%f in ('dir /S /b %FILEEXTENSION%') do (ECHO %%f && set /a count+=1)
ECHO -
ECHO Found %count% File(s) with File Extension %FILEEXTENSION% in Directory:
ECHO %DIRECTORY%.
ECHO -
ECHO Running this/them now, with your permissions!
FOR /F "tokens=*" %%f in ('dir /S /b %FILEEXTENSION%') do (PowerShell.exe -Command "& {Start-Process PowerShell.exe -WindowStyle hidden '-ExecutionPolicy Bypass -File "%%f"'}")
ECHO -
ECHO This Window will close in:
#timeout /T 10
endlocal
exit

View File

@ -0,0 +1,15 @@
-------------------------------------------------------------------------------
Version 1.0.0.0 - ??.02.2017
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,45 @@
@ECHO OFF
TITLE DIGITAL DATA - Run all files in directory with current permissions
ECHO -
ECHO Batch Script
ECHO Run all files in directory with current permissions
ECHO -
ECHO Digital Data
ECHO Ludwig-Rinn-Strasse 16
ECHO 35452 Heuchelheim
ECHO Tel.: 0641 / 202360
ECHO E-Mail: info@didalog.de
ECHO -
ECHO Version 1.0.0.0
ECHO Date: 13.08.2015
ECHO -
ECHO Program Startup %date% at %time:~0,8% oclock, on %computername%.
REM --------------------------------------------------------------
REM ------------------------set variables-------------------------
REM --------------------------------------------------------------
setlocal enableextensions
SET DIRECTORY="%cd%"
SET FILEEXTENSION=*.ps1
SET COUNT=0
REM --------------------------------------------------------------
REM ---------------------Program 1 / Script 1---------------------
REM --------------------------------------------------------------
FOR /F "tokens=*" %%f in ('dir /S /b %FILEEXTENSION%') do (ECHO %%f && set /a count+=1)
ECHO -
ECHO Found %count% File(s) with File Extension %FILEEXTENSION% in Directory:
ECHO %DIRECTORY%.
ECHO -
ECHO Running this/them now, with your permissions!
FOR /F "tokens=*" %%f in ('dir /S /b %FILEEXTENSION%') do (PowerShell.exe -Command "& {Start-Process PowerShell.exe -WindowStyle hidden '-ExecutionPolicy Bypass -File "%%f" -argOperationMode "install"'}")
ECHO -
ECHO This Window will close in:
#timeout /T 10
endlocal
exit

View File

@ -0,0 +1,39 @@
####################################################################################################
# Digital Data Configuration File (Template Date: 30.07.2016) #
# UTF-8 Coding required! #
# incl. FailSafe functions that are active when information is missing. #
####################################################################################################
#==================================================================================================#
########################################## General Setup ###########################################
#==================================================================================================#
####################################################################################################
# Path in which the log files will be stored. #
# Example: E:\LogFiles\<ScriptName> #
# FailSafe Setting is: <ScriptPath> #
####################################################################################################
LogPath =
####################################################################################################
# Numerical value how long (in days) log files will be kept. ValidateRange is 0 - 1000 #
# Value of 0 disables the delete function completely. #
# FailSafe Setting is: 60 #
####################################################################################################
LogFileKeepTime = 3
#==================================================================================================#
########################################## Impersonation ###########################################
#==================================================================================================#
####################################################################################################
# Numerical value how long (in days) log files will be kept. ValidateRange is 0 - 1000 #
# Value of 0 disables the delete function completely. #
# Example: LocalSMBShare = D:\SharedFolder #
####################################################################################################
LocalSMBShare = 3
#==================================================================================================#
########################################## Impersonation ###########################################
#==================================================================================================#

View File

@ -0,0 +1,7 @@
06.01.2017-14:03:49:
06.01.2017-14:03:49: ********************************************************************************
06.01.2017-14:03:49: Program Startup: Block-AccessByEventLog on DD-PC-STD01,
06.01.2017-14:03:49: from Account DIGITALDATA\KammM.
06.01.2017-14:03:49: ********************************************************************************
06.01.2017-14:03:49:
06.01.2017-14:03:49: Running in install mode...

View File

@ -0,0 +1 @@
[Violated File Group] located at: [Source File Path]. It was created by User: [Source Io Owner]. Ressource-Manager should block future accessing.

View File

@ -0,0 +1,4 @@
-mehrere Profile pro ini
- Benutzer ausschließen
- e-Mail?
- Logging!

View File

@ -0,0 +1,15 @@
-------------------------------------------------------------------------------
Version 1.0.0.0 - 31.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
-------------------------------------------------------------------------------

File diff suppressed because one or more lines are too long

View File

@ -0,0 +1,23 @@
-------------------------------------------------------------------------------
Version 1.0.1.0 - 25.11.2020
NEW: -
FIX: -
CHG: - Abort Button integrated
REM: -
-------------------------------------------------------------------------------
Version 1.0.0.0 - 31.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
-------------------------------------------------------------------------------

File diff suppressed because one or more lines are too long

View File

@ -0,0 +1,15 @@
-------------------------------------------------------------------------------
Version 1.0.0.0 - 28.07.2021 - Erste Version
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,232 @@
' CallPersonenkontenUebertragen_WebService
' ----------------------------------------------------------------------------
' Diese Subroutine löscht einen Datensatz anhand einer selktierten Gridzeile.
' Parameter 1 (Kennzeichen) = Kontotyp - 2 = Kunde; 3 = Lieferant
' Parameter 2 (AccountNr) = Das zu übertragende Konto
' Parameter 3 (Mandator) = Der Zielmandant
'
' ----------------------------------------------------------------------------
' 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: 28.07.2021 / MK
' Version Date / Editor: 28.07.2021 / MK
' Version Number: 1.0.0.0
Function CallPersonenkontenUebertragen_WebService(Kennzeichen,AccountNr,Mandator)
IF (DEBUG_ON = True) Or (DebugMode = "Enabled") THEN
MSGBOX "Kennzeichen: " & Kennzeichen & vbCrLf &_
"AccountNr: " & AccountNr & vbCrLf &_
"Mandator: " & Mandator & vbCrLf &_
"",,DEBUG_TITLE& " - Call Webservice"
End if
'Template var
WebServiceTemplate = Empty
'-------------------------------------------------------------------------------------------
'Its a customer account
If (Kennzeichen = 2) Then
'Build raw XML
XML = Empty
XML = XML & "<?xml version=""1.0"" encoding=""UTF-8""?>"
XML = XML & "<MESOWebService TemplateType=""%WebServiceType%"" Template=""%WebServiceTemplate%"">"
XML = XML & "<%WebServiceTemplate%>"
'WinLine standard fields
XML = XML & "<Kontonummer>" & Kontonummer & "</Kontonummer>"
XML = XML & "<Inaktiv>" & Inaktiv & "</Inaktiv>"
XML = XML & "<Rechnungsempfaenger>" & Rechnungsempfaenger & "</Rechnungsempfaenger>"
XML = XML & "<RechnungsversandE_Mail_Adresse>" & RechnungsversandE_Mail_Adresse & "</RechnungsversandE_Mail_Adresse>"
XML = XML & "<Kontoname>" & Kontoname & "</Kontoname>"
XML = XML & "<Kontoname2>" & Kontoname2 & "</Kontoname2>"
XML = XML & "<Strasse>" & Strasse & "</Strasse>"
XML = XML & "<Postleitzahl>" & Postleitzahl & "</Postleitzahl>"
XML = XML & "<Ort>" & Ort & "</Ort>"
XML = XML & "<Staat>" & Staat & "</Staat>"
XML = XML & "<Land>" & Land & "</Land>"
XML = XML & "<Landesvorwahl>" & Landesvorwahl & "</Landesvorwahl>"
XML = XML & "<Ortsvorwahl>" & Ortsvorwahl & "</Ortsvorwahl>"
XML = XML & "<Telefon>" & Telefon & "</Telefon>"
XML = XML & "<LandesvorwahlFax>" & LandesvorwahlFax & "</LandesvorwahlFax>"
XML = XML & "<OrtsvorwahlFax>" & OrtsvorwahlFax & "</OrtsvorwahlFax>"
XML = XML & "<Fax>" & Fax & "</Fax>"
XML = XML & "<E_Mail_Adresse>" & E_Mail_Adresse & "</E_Mail_Adresse>"
XML = XML & "<WWW_Adresse>" & WWW_Adresse & "</WWW_Adresse>"
XML = XML & "<Vertreter>" & Vertreter & "</Vertreter>"
XML = XML & "<Versandart>" & Versandart & "</Versandart>"
XML = XML & "<GLN>" & GLN & "</GLN>"
XML = XML & "<Haendler>" & Haendler & "</Haendler>"
XML = XML & "<IDNr>" & IDNr & "</IDNr>"
XML = XML & "<Steuerleiste>" & Steuerleiste & "</Steuerleiste>"
XML = XML & "<Best_Price>" & Best_Price & "</Best_Price>"
'custom DB Fields
XML = XML & "<Haupthaus>" & Haupthaus & "</Haupthaus>"
'custom additional Fields
XML = XML & "<IFSteuernummer>" & IFSteuernummer & "</IFSteuernummer>"
XML = XML & "<IFNotizAltsystem>" & IFNotizAltsystem & "</IFNotizAltsystem>"
XML = XML & "<IFUmsatz2021Altsystem>" & IFUmsatz2021Altsystem & "</IFUmsatz2021Altsystem>"
XML = XML & "<IFUmsatz2020Altsystem>" & IFUmsatz2020Altsystem & "</IFUmsatz2020Altsystem>"
XML = XML & "<IFFiBuDebitorNummer>" & IFFiBuDebitorNummer & "</IFFiBuDebitorNummer>"
XML = XML & "<IFEntfernung>" & IFEntfernung & "</IFEntfernung>"
'custom properties
XML = XML & "<IFEinkaufsverband>" & IFEinkaufsverband & "</IFEinkaufsverband>"
XML = XML & "<IFVersandtag>" & IFVersandtag & "</IFVersandtag>"
XML = XML & "<IFLiefertag>" & IFLiefertag & "</IFLiefertag>"
XML = XML & "<IFZuordnung_Filiale>" & IFZuordnung_Filiale & "</IFZuordnung_Filiale>"
XML = XML & "<IFBranche>" & IFBranche & "</IFBranche>"
XML = XML & "<IFLiefersperre>" & IFLiefersperre & "</IFLiefersperre>"
XML = XML & "</%WebServiceTemplate%>"
XML = XML & "</MESOWebService>"
'Replace placeholder in XML
XML = Replace(XML,"%WebServiceType%",WebServiceType)
XML = Replace(XML,"%WebServiceTemplate%",Replace(WebServiceTemplate_Debtor," ",""))
WebServiceTemplate = WebServiceTemplate_Debtor
'-------------------------------------------------------------------------------------------
'Its a vendor account
ElseIf (Kennzeichen = 3) Then
'Build raw XML
XML = Empty
XML = XML & "<?xml version=""1.0"" encoding=""UTF-8""?>"
XML = XML & "<MESOWebService TemplateType=""%WebServiceType%"" Template=""%WebServiceTemplate%"">"
XML = XML & "<%WebServiceTemplate%>"
'WinLine standard fields
XML = XML & "<Kontonummer>" & Kontonummer & "</Kontonummer>"
XML = XML & "<Inaktiv>" & Inaktiv & "</Inaktiv>"
XML = XML & "<Kontoname>" & Kontoname & "</Kontoname>"
XML = XML & "<Kontoname2>" & Kontoname2 & "</Kontoname2>"
XML = XML & "<Strasse>" & Strasse & "</Strasse>"
XML = XML & "<Postleitzahl>" & Postleitzahl & "</Postleitzahl>"
XML = XML & "<Ort>" & Ort & "</Ort>"
XML = XML & "<Staat>" & Staat & "</Staat>"
XML = XML & "<Land>" & Land & "</Land>"
XML = XML & "<Landesvorwahl>" & Landesvorwahl & "</Landesvorwahl>"
XML = XML & "<Ortsvorwahl>" & Ortsvorwahl & "</Ortsvorwahl>"
XML = XML & "<Telefon>" & Telefon & "</Telefon>"
XML = XML & "<LandesvorwahlFax>" & LandesvorwahlFax & "</LandesvorwahlFax>"
XML = XML & "<OrtsvorwahlFax>" & OrtsvorwahlFax & "</OrtsvorwahlFax>"
XML = XML & "<Fax>" & Fax & "</Fax>"
XML = XML & "<E_Mail_Adresse>" & E_Mail_Adresse & "</E_Mail_Adresse>"
XML = XML & "<WWW_Adresse>" & WWW_Adresse & "</WWW_Adresse>"
XML = XML & "<Lieferbedingungen>" & Lieferbedingungen & "</Lieferbedingungen>"
XML = XML & "<Fremdkontonummer>" & Fremdkontonummer & "</Fremdkontonummer>"
'custom additional Fields
XML = XML & "<IFNummerAltsystem>" & IFNummerAltsystem & "</IFNummerAltsystem>"
'custom properties
XML = XML & "<IFLieferwerk>" & IFLieferwerk & "</IFLieferwerk>"
XML = XML & "<IFWerkszuordnung_Kuerzel>" & IFWerkszuordnung_Kuerzel & "</IFWerkszuordnung_Kuerzel>"
XML = XML & "</%WebServiceTemplate%>"
XML = XML & "</MESOWebService>"
'Replace placeholder in XML
XML = Replace(XML,"%WebServiceType%",WebServiceType)
XML = Replace(XML,"%WebServiceTemplate%",Replace(WebServiceTemplate_Creditor," ",""))
WebServiceTemplate = WebServiceTemplate_Creditor
End if
'-------------------------------------------------------------------------------------------'
'--------------------------------| prepare webservice call |--------------------------------'
'-------------------------------------------------------------------------------------------'
If (Kennzeichen > 0) and (WebServiceTemplate <> Empty) Then
'Build webservice URL
URL = "http://%SERVER%/ewlservice/import?User=%USER%&Password=%PASSWORD%&Company=%COMPANY%&Type=1&Vorlage=%VORLAGE%&Actioncode=%ACTIONCODE%&byref=0&Data=%DATA%"
URL = Replace(URL,"%SERVER%", WebServiceURL)
URL = Replace(URL,"%USER%", WebServiceBenutzerName)
URL = Replace(URL,"%PASSWORD%", WebServiceBenutzerPasswort)
URL = Replace(URL,"%COMPANY%", ComboBox1.Value)
URL = Replace(URL,"%VORLAGE%", WebServiceTemplate)
URL = Replace(URL,"%ACTIONCODE%",WebServiceType)
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
msgbox URL,,DEBUG_TITLE&" - WebService URL"
msgbox XML,,DEBUG_TITLE&" - WebService XML"
End if
'Set XML content
URL = Replace(URL,"%DATA%", XML)
'-------------------------------------------------------------------------------------------
'Send request to WebServer
HTTPRequest.Open "POST", URL, False
HTTPRequest.Send
IF (HTTPRequest.Status = 200) Then
If InStr(HTTPRequest.ResponseText, "<?xml") = 1 Then
Doc.loadXML(HTTPRequest.ResponseText)
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
msgbox "Die Übertragung war erfolgreich!" & vbCrlf & vbCrlf & _
"Bitte prüfen Sie nun noch Felder," & vbCrlf & _
"welche von der Übertragung ausgeschloßen sind."& vbCrlf & vbCrlf & _
"Beispiele: " & vbCrlf & _
"ZahlungskonditionFIBU, ZahlungskonditionFAKT," & vbCrlf & _
"Belegart, Lieferbedingungen, BKZ, ..." & vbCrlf & _
"",vbInformation,DEFAULT_TITLE
Else
msgbox "Fehler bei der Übertragung!" & vbCrLf &_
HTTPRequest.ResponseText & vbCrLf &_
"",,DEFAULT_TITLE &" - WebServices"
End If
Else
msgbox "Fehler bei der Übertragung!" & vbCrLf &_
HTTPRequest.ResponseText & vbCrLf &_
"",,DEFAULT_TITLE &" - WebServices"
End If
Else
msgbox "Fehler bei der Übertragung!" & vbCrLf &_
HTTPRequest.ResponseText & vbCrLf &_
"",,DEFAULT_TITLE &" - WebServices"
End if
Else
msgbox "Fehler bei der Übertragung!" & vbCrLf &_
"Der Aufruf ist unvollständig!" & vbCrLf &_
"",,DEFAULT_TITLE &" - WebServices"
End if
End Function

View File

@ -0,0 +1,22 @@
' DisablePersonenkontenUebertragen_Buttons
' ----------------------------------------------------------------------------
' Diese Subroutine deaktiviert den Übertragungsknopf.
'
' ----------------------------------------------------------------------------
' 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: 24.07.2021 / MD
' Version Date / Editor: 24.07.2021 / MD
' Version Number: 1.0.0.0
Sub DisablePersonenkontenUebertragen_Buttons()
If (ComboBox1.Value = Empty) Then
CommandButton1.Enabled = 0
End If
End Sub

View File

@ -0,0 +1,22 @@
' EnablePersonenkontenUebertragen_Buttons
' ----------------------------------------------------------------------------
' Diese Subroutine aktiviert den Übertragungsknopf.
'
' ----------------------------------------------------------------------------
' 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: 24.07.2021 / MD
' Version Date / Editor: 24.07.2021 / MD
' Version Number: 1.0.0.0
Sub EnablePersonenkontenUebertragen_Buttons()
If (ComboBox1.Value <> Empty) Then
CommandButton1.Enabled = 1
End If
End Sub

View File

@ -0,0 +1,34 @@
' GetPersonenkontenUebertragen_AccountNr
' ----------------------------------------------------------------------------
' Diese Subroutine ließt die im Personenkonto Fenster ausgewählte Personenkonto Nummer aus.
'
' ----------------------------------------------------------------------------
' 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: 24.07.2021 / MD
' Version Date / Editor: 24.07.2021 / MD
' Version Number: 1.0.0.0
Sub GetPersonenkontenUebertragen_AccountNr()
MacroCommands.Mwindow Personenkonto_WindowID, False
MacroCommands.MActivateWindow Personenkonto_WindowID
TextBox1.Value = MacroCommands.MGetFieldValue(Personenkonto_WindowID, Personenkonto_AccountNrID)
'If read value is geater null,
'disable box to avoid modifications
If (TextBox1.Value <> Empty) Then
TextBox1.Enabled = 0
ComboBox1.Enabled = 1
Else
Msgbox "Das Personenkonto konnte nicht ausgelesen werden," & vbCrlf & _
"Bitte geben Sie die Kontonummer manuell ein!" & vbCrlf & _
"",vbInformation, DEFAULT_TITLE
End If
End Sub

View File

@ -0,0 +1,271 @@
' GetPersonenkontenUebertragen_Record
' ----------------------------------------------------------------------------
' Diese Subroutine ermittelt die Daten eines Persoenenkontos
'
' ----------------------------------------------------------------------------
' 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: 28.07.2021 / MK
' Version Date / Editor: 28.07.2021 / MK
' Version Number: 1.0.0.0
Function GetPersonenkontenUebertragen_Record(AccountNr)
SQLQuery_AccountInfo = SQLQuery_AccountInfo_Template
SQLQuery_AccountInfo = Replace(SQLQuery_AccountInfo,"%AccountNr%",TextBox1.Value)
Set SQLResult_AccountInfo = Conn.Select(SQLQuery_AccountInfo)
If (SQLResult_AccountInfo.RowCount) > 0 Then
'WinLine standard fields
Kontonummer = SQLResult_AccountInfo.value("c002")
Kennzeichen = SQLResult_AccountInfo.value("c004") '1= ???; 2 = Kunde; 3 = Lieferant; 4 = Interessent
Inaktiv = SQLResult_AccountInfo.value("c105")
Rechnungsempfaenger = SQLResult_AccountInfo.value("c130")
RechnungsversandE_Mail_Adresse = SQLResult_AccountInfo.value("c187")
Kontoname = SQLResult_AccountInfo.value("c003")
Kontoname2 = SQLResult_AccountInfo.value("c084")
Strasse = SQLResult_AccountInfo.value("c050")
Postleitzahl = SQLResult_AccountInfo.value("c051")
Ort = SQLResult_AccountInfo.value("c052")
Staat = SQLResult_AccountInfo.value("c097")
Land = SQLResult_AccountInfo.value("c123")
Landesvorwahl = SQLResult_AccountInfo.value("c140")
Ortsvorwahl = SQLResult_AccountInfo.value("c141")
Telefon = SQLResult_AccountInfo.value("c019")
LandesvorwahlFax = SQLResult_AccountInfo.value("c251")
OrtsvorwahlFax = SQLResult_AccountInfo.value("c252")
Fax = SQLResult_AccountInfo.value("c020")
E_Mail_Adresse = SQLResult_AccountInfo.value("c116")
WWW_Adresse = SQLResult_AccountInfo.value("c128")
Vertreter = SQLResult_AccountInfo.value("c065")
Versandart = SQLResult_AccountInfo.value("c121")
GLN = SQLResult_AccountInfo.value("c260")
Haendler = SQLResult_AccountInfo.value("c169")
IDNr = SQLResult_AccountInfo.value("c022")
Steuerleiste = SQLResult_AccountInfo.value("c067")
Best_Price = SQLResult_AccountInfo.value("c184")
Lieferbedingungen = SQLResult_AccountInfo.value("c134")
Fremdkontonummer = SQLResult_AccountInfo.value("c188")
BKZ1 = SQLResult_AccountInfo.value("c007")
BKZ1Wechselkonto = SQLResult_AccountInfo.value("c008")
ZahlungskonditionFIBU = SQLResult_AccountInfo.value("c100")
ZahlungskonditionFAKT = SQLResult_AccountInfo.value("c107")
Belegart = SQLResult_AccountInfo.value("c077")
Preisliste = SQLResult_AccountInfo.value("c066")
'-----------------------------------------------------------------------------------------------'
'custom properties, first reset them
IFLieferwerk = Empty
IFEinkaufsverband = Empty
IFVersandtag = Empty
IFLiefertag = Empty
IFZuordnung_Filiale = Empty
IFWerkszuordnung_Kuerzel = Empty
IFBranche = Empty
IFLiefersperre = Empty
For Each PropertyID In PropertyIDs
SQLQuery_PropertyRootParent = SQLQuery_PropertyRootParent_Template
SQLQuery_PropertyRootParent = Replace(SQLQuery_PropertyRootParent,"%PropertyID%",PropertyID)
Set SQLResult_PropertyRoot = Conn.Select(SQLQuery_PropertyRootParent)
If (SQLResult_PropertyRoot.RowCount) > 0 Then
'Get internal ID IFEinkaufsverband -> 1014 -> 1008
PropertyNumberRange = SQLResult_PropertyRoot.value("c000")
IF (PropertyNumberRange > 0) Then
SQLQuery_PropertyMapping = SQLQuery_PropertyMapping_Template
SQLQuery_PropertyMapping = Replace(SQLQuery_PropertyMapping,"%AccountNr%",AccountNr)
SQLQuery_PropertyMapping = Replace(SQLQuery_PropertyMapping,"%PropertyNumberRange%",PropertyNumberRange)
SQLQuery_PropertyMapping = Replace(SQLQuery_PropertyMapping,vbCr,"")
SQLQuery_PropertyMapping = Replace(SQLQuery_PropertyMapping,vbLf,"")
Set SQLResult_PropertyMapping = Conn.Select(SQLQuery_PropertyMapping)
IF (DEBUG_ON = True) Or (DebugMode = "Enabled") THEN
MSGBOX SQLQuery_PropertyMapping,,DEBUG_TITLE&" - SQL"
MSGBOX SQLResult_PropertyMapping.RowCount,,DEBUG_TITLE&" - RowCount"
End if
If (SQLResult_PropertyMapping.RowCount) > 0 Then
Do
PropertyID_DB = SQLResult_PropertyMapping.value("c999")
PropertyNumberRange_DB = SQLResult_PropertyMapping.value("c000")
PropertyValueID = SQLResult_PropertyMapping.value("c001")
PropertyValue = SQLResult_PropertyMapping.value("c010")
IF (DEBUG_ON = True) Or (DebugMode = "Enabled") THEN
MSGBOX "PropertyID from Loop: " & PropertyID & vbCrLf &_
"PropertyID from DB: " & PropertyID_DB & vbCrLf & vbCrLf &_
"PropertyNumberRange from Loop: " & PropertyNumberRange & vbCrLf &_
"PropertyNumberRange from DB: " & PropertyNumberRange_DB & vbCrLf & vbCrLf &_
"PropertyValueID: " & PropertyValueID & vbCrLf &_
"PropertyValue: " & PropertyValue & vbCrLf &_
"",,DEBUG_TITLE&" - Eigenschaften"
End if
'-----------------------------------------------------------------------------------------------'
'---------------------------| Code block to save properties in vars |---------------------------'
'-----------------------------------------------------------------------------------------------'
IF (PropertyID_IFLieferwerk = PropertyID_DB) Then
IF (IFLieferwerk = "null") or (IFLieferwerk = Empty) or (IFLieferwerk = "") or (IFLieferwerk = " ") or IsNull(IFLieferwerk) then
IFLieferwerk = 0
Else
IFLieferwerk = 1
End if
ElseIf (PropertyID_IFEinkaufsverband = PropertyID_DB) Then
IF (IFEinkaufsverband <> Empty and IFEinkaufsverband <> PropertyValue) Then
IFEinkaufsverband = IFEinkaufsverband & ";" & PropertyValue
Else
IFEinkaufsverband = IFEinkaufsverband & PropertyValue
End if
ElseIf (PropertyID_IFVersandtag = PropertyID_DB) Then
IF (IFVersandtag <> Empty and IFVersandtag <> PropertyValue) Then
IFVersandtag = IFVersandtag & ";" & PropertyValue
Else
IFVersandtag = IFVersandtag & PropertyValue
End if
ElseIf (PropertyID_IFLiefertag = PropertyID_DB) Then
IF (IFLiefertag <> Empty and IFLiefertag <> PropertyValue) Then
IFLiefertag = IFLiefertag & ";" & PropertyValue
Else
IFLiefertag = IFLiefertag & PropertyValue
End if
ElseIf (PropertyID_IFZuordnung_Filiale = PropertyID_DB) Then
IF (IFZuordnung_Filiale <> Empty and IFZuordnung_Filiale <> PropertyValue) Then
IFZuordnung_Filiale = IFZuordnung_Filiale & ";" & PropertyValue
Else
IFZuordnung_Filiale = IFZuordnung_Filiale & PropertyValue
End if
ElseIf (PropertyID_IFWerkszuordnung_Kuerzel = PropertyID_DB) Then
IF (IFWerkszuordnung_Kuerzel <> Empty and IFWerkszuordnung_Kuerzel <> PropertyValue) Then
IFWerkszuordnung_Kuerzel = IFWerkszuordnung_Kuerzel & ";" & PropertyValue
Else
IFWerkszuordnung_Kuerzel = IFWerkszuordnung_Kuerzel & PropertyValue
End if
ElseIf (PropertyID_IFBranche = PropertyID_DB) Then
IF (IFBranche <> Empty and IFBranche <> PropertyValue) Then
IFBranche = IFBranche & ";" & PropertyValue
Else
IFBranche = IFBranche & PropertyValue
End if
ElseIf (PropertyID_IFLiefersperre = PropertyID_DB) Then
IF (IFLiefersperre = "null") or (IFLiefersperre = Empty) or (IFLiefersperre = "") or (IFLiefersperre = " ") or IsNull(IFLiefersperre) then
IFLiefersperre = 0
Else
IFLiefersperre = 1
End if
End if
'----------------------------------------------------------------------------------------------
'Trick loop, because rowcount wont work
If (SQLResult_PropertyMapping.NextRecord = False) Then
Exit Do
End If
Loop
End If
End if
End if
Next
'-----------------------------------------------------------------------------------------------'
IF (Kennzeichen = 1) Then
msgbox "Aktuell nicht implementiert! Bitte manuell anlegen!"
ElseIF (Kennzeichen = 2) Then
'custom DB Fields
Haupthaus = SQLResult_AccountInfo.value("u100")
'custom additional Fields
IFSteuernummer = SQLResult_AccountInfo.value("c203")
IFNotizAltsystem = SQLResult_AccountInfo.value("c208")
IFUmsatz2021Altsystem = SQLResult_AccountInfo.value("c209")
IFUmsatz2020Altsystem = SQLResult_AccountInfo.value("c210")
IFFiBuDebitorNummer = SQLResult_AccountInfo.value("c211")
IFEntfernung = SQLResult_AccountInfo.value("c212")
ElseIF (Kennzeichen = 3) Then
'custom additional Fields
IFNummerAltsystem = SQLResult_AccountInfo.value("c207")
ElseIF (Kennzeichen = 4) Then
msgbox "Aktuell nicht implementiert! Bitte manuell anlegen!"
End if
'-----------------------------------------------------------------------------------------------'
'---------------------------| Final adjust vars for webservice call |---------------------------'
'-----------------------------------------------------------------------------------------------'
If (Inaktiv = "null") or (Inaktiv = Empty) or (Inaktiv = "") or (Inaktiv = " ") or IsNull(Inaktiv) then
Inaktiv = 0
Else
Inaktiv = cdate(Inaktiv)
End if
If (IFLieferwerk = "null") or (IFLieferwerk = Empty) or (IFLieferwerk = "") or (IFLieferwerk = " ") or IsNull(IFLieferwerk) or (IFLieferwerk = 0) or (IFLieferwerk = false) then
IFLieferwerk = 0
Else
IFLieferwerk = 1
End if
If (IFLiefersperre = "null") or (IFLiefersperre = Empty) or (IFLiefersperre = "") or (IFLiefersperre = " ") or IsNull(IFLiefersperre) or (IFLiefersperre = 0) or (IFLiefersperre = false) then
IFLiefersperre = 0
Else
IFLiefersperre = 1
End if
If (Lieferbedingungen = "null") or (Lieferbedingungen = Empty) or (Lieferbedingungen = "") or (Lieferbedingungen = " ") or IsNull(Lieferbedingungen) or (Lieferbedingungen = 0) or (Lieferbedingungen = false) then
Lieferbedingungen = 0
Else
Lieferbedingungen = 1
End if
'-----------------------------------------------------------------------------------------------'
GetPersonenkontenUebertragen_Record = Kennzeichen
Else
GetPersonenkontenUebertragen_Record = 0
End if
End Function

View File

@ -0,0 +1,39 @@
' SetPersonenkontenUebertragen_Mandators
' ----------------------------------------------------------------------------
' Diese Funktion liefert Werte, um Auswahlbox zu füllen.
'
' ----------------------------------------------------------------------------
' 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: 24.07.2021 / MK
' Version Date / Editor: 24.07.2021 / MK
' Version Number: 1.0.0.0
Sub SetPersonenkontenUebertragen_Mandators()
Set SQLResult_Mandators = Conn.Select(SQLQuery_Mandators)
If (SQLResult_Mandators.RowCount) > 0 Then
'First clear box to avoid old values
ComboBox1.Enabled = 1
ComboBox1.Clear
Do
'Loop for every combobox value
If (SQLResult_Mandators.NextRecord = True) Then
ComboBox1.AddItem SQLResult_Mandators.value("c000")
Else
Exit Do
End If
Loop
Else
ComboBox1.Enabled = 0
End If
End Sub

View File

@ -0,0 +1,31 @@
' SetupPersonenkontenUebertragen_Window
' ----------------------------------------------------------------------------
' Diese Subroutine stellt das
'
' ----------------------------------------------------------------------------
' 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: 24.07.2021 / MD
' Version Date / Editor: 24.07.2021 / MD
' Version Number: 1.0.0.0
Sub SetupPersonenkontenUebertragen_Window()
Label1.Enabled = 1
Label1.Caption = "1. Ausgewähltes Personenkonto"
Label1.AutoSize = 1
Label2.Enabled = 1
Label2.Caption = "2. Zielmandant wählen"
Label2.AutoSize = 1
ComboBox1.Enabled = 0
CommandButton1.Enabled = 0
CommandButton1.Caption = "3. Personenekonto übertragen"
CommandButton1.AutoSize = 1
End Sub

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
-------------------------------------------------------------------------------

View File

@ -0,0 +1,20 @@
Version 3.1.0.0 - 09.10.2021
NEW: - Added Additional Fields (Personenkonten Zusatzfelder)
FIX: -
CHG: -
REM: -
-------------------------------------------------------------------------------
Version 3.0.0.0 - 16.07.2021 (30.08.2021, 09.10.2021) - Erste Version des Relaunchs
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,115 @@
' DeleteExportWinLineDoc_Record
' ----------------------------------------------------------------------------
' Diese Subroutine löscht einen Datensatz anhand einer selktierten Gridzeile.
' Parameter 1 (LEVEL) = Das aktuelle Showlevel übergeben.
' Parameter 2 (GRID) = Falls mehrere Grids auf einem Level vorkommen, kann über diesen Parameter nochmals unterscheiden werden.
' Parameter 3 (ROW) = Zu löschende Zeile im Grid (nur zwecks Anzeige).
' Parameter 4 (GRID) = Eindeutige Nummer des zu löschenden Datensatzes (zwecks Löschung in der DB).
'
' ----------------------------------------------------------------------------
' 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: 04.07.2021 / MD
' Version Date / Editor: 04.07.2021 / MD
' Version Number: 1.0.0.0
Sub DeleteExportWinLineDoc_Record(LEVEL,GRID,ROW,GUID)
If (((LEVEL = 1) or (LEVEL = "1")) and (ROW > 0) and (GUID > 0)) Then
If (GRID = LEVEL1_GRID_ID) Then
MsgBoxQuestion = MsgBox ("Möchten Sie den ausgewählten Datensatz wirklich löschen? " & vbCrlf & vbCrlf & _
"Beschreibung: " & LEVEL1_GRID_CURRENT_Beschreibung & vbCrlf & vbCrlf & _
"Mandant: " & LEVEL1_GRID_CURRENT_Mandant & vbCrlf & vbCrlf & _
"Achtung der Vorgang kann nicht Rückgängig gemacht werden!" & vbCrlf & _
"", vbYesno+vbQuestion, DEFAULT_TITLE & " - Löschen bestätigen!")
If (MsgBoxQuestion = 6) Then
SQLDelete_Profile = REPLACE(SQLDelete_Profile_Template,"%GUID%",GUID)
SQLResult_Profile = Conn.ExecuteSQL(SQLDelete_Profile)
If (SQLResult_Profile = "Wahr") Or (SQLResult_Profile = 1) Then
LEVEL1_Grid.RemoveLine ROW
'LEVEL1_Grid.Refresh << Dont do this selected line will lose
If (LEVEL1_Grid.LineCount > 0) Then
'Show updated count down the table
LEVEL1_TXT_TabelCounter.Contents = (Cstr(LEVEL1_Grid.LineCount) & " Zuordnungen gefunden")
Else
LEVEL1_TXT_TabelCounter.Contents = "Keine Zuordnungen gefunden"
End If
MsgBox "Der Datensatz wurde erfolgreich gelöscht!",vbOkayonly+vbInformation,DEFAULT_TITLE & " - Erfolg!"
Else
MsgBox "Der Datensatz konnte nicht gelöscht werden!",vbOkayonly+vbCritical,DEFAULT_TITLE & " - Fehler!"
End If
End if
End If
ElseIf (((LEVEL = 2) or (LEVEL = "2")) and (ROW > 0) and (GUID > 0)) Then
If (GRID = LEVEL2_GRID_ID) Then
MsgBoxQuestion = MsgBox ("Möchten Sie den ausgewählten Datensatz wirklich löschen? " & vbCrlf & vbCrlf & _
"Beschreibung: " & LEVEL2_GRID_CURRENT_Beschreibung & vbCrlf & vbCrlf & _
"Mandant: " & LEVEL2_GRID_CURRENT_Mandant & vbCrlf & vbCrlf & _
"Achtung der Vorgang kann nicht Rückgängig gemacht werden!" & vbCrlf & _
"", vbYesno+vbQuestion, DEFAULT_TITLE & " - Löschen bestätigen!")
If (MsgBoxQuestion = 6) Then
SQLDelete_Config = REPLACE(SQLDelete_Config_Template,"%GUID%",GUID)
SQLResult_Config = Conn.ExecuteSQL(SQLDelete_Config)
If (SQLResult_Config = "Wahr") Or (SQLResult_Config = 1) Then
LEVEL2_Grid.RemoveLine ROW
'LEVEL2_Grid.Refresh << Dont do this selected line will lose
If (LEVEL2_Grid.LineCount > 0) Then
'Show updated count down the table
LEVEL2_TXT_TabelCounter.Contents = (Cstr(LEVEL2_Grid.LineCount) & " Zuordnungen gefunden")
Else
LEVEL2_TXT_TabelCounter.Contents = "Keine Zuordnungen gefunden"
End If
MsgBox "Der Datensatz wurde erfolgreich gelöscht!",vbOkayonly+vbInformation,DEFAULT_TITLE & " - Erfolg!"
Else
MsgBox "Der Datensatz konnte nicht gelöscht werden!",vbOkayonly+vbCritical,DEFAULT_TITLE & " - Fehler!"
End If
End if
Else
Msgbox "Unzureichende Parameter!" & vbCrlf & _
"LEVEL: " & LEVEL & vbCrlf & _
"ROW: " & ROW & vbCrlf & _
"GUID: " & GUID & vbCrlf & _
"",vbOkayonly+vbCritical,DEFAULT_TITLE & " - Fehler!"
End If
End If
End Sub

View File

@ -0,0 +1,91 @@
' DD-INSERT_LANGBESCHINT_INTO_BELEGERFASSUNG
' ----------------------------------------------------------------------------
' Diese Subroutine deaktiviert Knöpfe im Ribbon und in Fenster.
' Parameter 1 (LEVEL) = Das aktuelle Showlevel übergeben.
' Parameter 2 (CTRLType)= "Static" deaktiviert pauschal, "dynamic" deaktiviert anhand anderer Laufzeitvariablen.
'
' ----------------------------------------------------------------------------
' 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: 16.07.2021 / MK
' Version Date / Editor: 16.07.2021 / MK
' Version Number: 1.0.0.0
Sub DisableExportWinLineDoc_ButtonControls(LEVEL,CTRLType)
If ((LEVEL = 0) or (LEVEL = "0")) and (CTRLType = "static") Then
LEVEL0_BTN_ABORT.Active = False
ElseIf ((LEVEL = 1) or (LEVEL = "1")) and (CTRLType = "static") Then
LEVEL0_BTN_OK.Active = False
LEVEL0_BTN_EXIT.Active = False
LEVEL1_TAB_LEVEL1_TO_LEVEL1.Active = False
LEVEL1_TAB_LEVEL1_TO_LEVEL2.Active = False
LEVEL1_TAB_LEVEL1_TO_LEVEL3.Active = False
ElseIf ((LEVEL = 2) or (LEVEL = "2")) and (CTRLType = "static") Then
LEVEL0_BTN_OK.Active = False
LEVEL0_BTN_EXIT.Active = False
LEVEL2_TAB_LEVEL2_TO_LEVEL1.Active = False
LEVEL2_TAB_LEVEL2_TO_LEVEL2.Active = False
LEVEL2_TAB_LEVEL2_TO_LEVEL3.Active = False
ElseIf ((LEVEL = 1) or (LEVEL = "1")) and (CTRLType = "dynamic") Then
If (LEVEL1_GRID_CURRENT_GUID = -1) Then
LEVEL0_BTN_NEW.Active = False
LEVEL0_BTN_DELETE.Active = False
ElseIf (LEVEL1_GRID_CURRENT_ROW >= 0) and (LEVEL1_GRID_CURRENT_GUID >= 0) Then
LEVEL0_BTN_ABORT.Active = False
LEVEL0_BTN_SAVE.Active = False
LEVEL0_BTN_DELETE.Active = False
ElseIf (LEVEL1_GRID_CURRENT_ROW <= 0) and (LEVEL1_GRID_CURRENT_GUID <= 0) Then
LEVEL0_BTN_SAVE.Active = False
LEVEL0_BTN_DELETE.Active = False
End if
ElseIf ((LEVEL = 2) or (LEVEL = "2")) and (CTRLType = "dynamic") Then
If (LEVEL2_GRID_CURRENT_GUID = -1) Then
LEVEL0_BTN_NEW.Active = False
LEVEL0_BTN_DELETE.Active = False
ElseIf (LEVEL2_GRID_CURRENT_ROW >= 0) and (LEVEL2_GRID_CURRENT_GUID >= 0) Then
LEVEL0_BTN_ABORT.Active = False
LEVEL0_BTN_SAVE.Active = False
LEVEL0_BTN_DELETE.Active = False
ElseIf (LEVEL2_GRID_CURRENT_ROW <= 0) and (LEVEL2_GRID_CURRENT_GUID <= 0) Then
LEVEL0_BTN_SAVE.Active = False
LEVEL0_BTN_DELETE.Active = False
End if
ElseIf ((LEVEL = 3) or (LEVEL = "3")) and (CTRLType = "static") Then
LEVEL0_BTN_OK.Active = False
LEVEL0_BTN_NEW.Active = False
LEVEL0_BTN_DELETE.Active = False
LEVEL0_BTN_SAVE.Active = False
LEVEL0_BTN_DELETE.Active = False
End if
End Sub

View File

@ -0,0 +1,141 @@
' DisableExportWinLineDoc_InputControls
' ----------------------------------------------------------------------------
' Diese Subroutine deaktiviert sämtliche Eingabefelder auf einem Level.
' Parameter 1 (LEVEL) = Das aktuelle Showlevel übergeben.
' Parameter 2 (CTRLType)= "Static" deaktiviert pauschal, "dynamic" deaktiviert anhand anderer Laufzeitvariablen.
'
' ----------------------------------------------------------------------------
' 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: 15.07.2021 / MK
' Version Date / Editor: 15.07.2021 / MK
' Version Number: 1.0.0.0
Sub DisableExportWinLineDoc_InputControls(LEVEL,CTRLType)
If ((LEVEL = 1) or (LEVEL = "1")) and (CTRLType = "static") Then
LEVEL1_CHK_Aktiv.Active = False
LEVEL1_TXT_Beschreibung.Active = False
LEVEL1_TXT_Mandant.Active = False
LEVEL1_TXT_WinLineVariable1.Active = False
LEVEL1_TXT_WinLineVariable2.Active = False
LEVEL1_TXT_WinLineVariable3.Active = False
LEVEL1_TXT_WinLineVariable4.Active = False
LEVEL1_TXT_WinLineVariable5.Active = False
LEVEL1_TXT_WinLineVariable6.Active = False
LEVEL1_TXT_WinLineVariable7.Active = False
LEVEL1_TXT_WinLineVariable8.Active = False
LEVEL1_TXT_WinLineVariable9.Active = False
LEVEL1_TXT_WinLineVariable10.Active = False
LEVEL1_TXT_CallMakroPreExport1.Active = False
LEVEL1_TXT_CallMakroPreExport2.Active = False
LEVEL1_TXT_CallMakroPreExport3.Active = False
LEVEL1_TXT_CallMakroPreExport4.Active = False
LEVEL1_TXT_CallMakroPreExport5.Active = False
LEVEL1_TXT_CallMakroPreExport6.Active = False
LEVEL1_TXT_CallMakroPreExport7.Active = False
LEVEL1_TXT_CallMakroPreExport8.Active = False
LEVEL1_TXT_CallMakroPreExport9.Active = False
LEVEL1_TXT_CallMakroPreExport10.Active = False
LEVEL1_TXT_ExportPfad.Active = False
LEVEL1_TXT_ExportDateiname.Active = False
LEVEL1_TXT_ExportDateinameVorschau.Active = False
LEVEL1_TXT_ExportDateiendung.Active = False
LEVEL1_TXT_ExportVersionierung.Active = False
LEVEL1_BTN_VariableEinfuegen1.Active = False
LEVEL1_BTN_VariableEinfuegen2.Active = False
LEVEL1_BTN_VariableEinfuegen3.Active = False
ElseIf ((LEVEL = 2) or (LEVEL = "2")) and (CTRLType = "static") Then
LEVEL2_CHK_Aktiv.Active = False
LEVEL2_TXT_Beschreibung.Active = False
LEVEL2_TXT_Mandant.Active = False
LEVEL2_TXT_Eintragstyp.Active = False
LEVEL2_TXT_Platzhalter.Active = False
LEVEL2_TXT_Datentyp.Active = False
LEVEL2_TXT_Text_Wert.Active = False
LEVEL2_TXT_Integer_Wert.Active = False
LEVEL2_TXT_Double_Wert.Active = False
LEVEL2_TXT_Date_Wert.Active = False
ElseIf ((LEVEL = 2) or (LEVEL = "2")) and (CTRLType = "dynamic") Then
IF (Instr( 1, LEVEL2_TXT_Datentyp.screencontents, "Text", vbTextCompare ) > 0) Then
LEVEL2_TXT_Text_Wert.Active = True
LEVEL2_TXT_Integer_Wert.Active = True
LEVEL2_TXT_Integer_Wert.Contents = 0
LEVEL2_TXT_Integer_Wert.Active = False
LEVEL2_TXT_Double_Wert.Active = True
LEVEL2_TXT_Double_Wert.Contents = 0.0
LEVEL2_TXT_Double_Wert.Active = False
LEVEL2_TXT_Date_Wert.Active = True
LEVEL2_TXT_Date_Wert.Contents = "01.01.1970"
LEVEL2_TXT_Date_Wert.Active = False
ElseIf (Instr( 1, LEVEL2_TXT_Datentyp.screencontents, "Integer", vbTextCompare ) > 0) Then
LEVEL2_TXT_Text_Wert.Active = True
LEVEL2_TXT_Text_Wert.Contents = ""
LEVEL2_TXT_Text_Wert.Active = False
LEVEL2_TXT_Integer_Wert.Active = True
LEVEL2_TXT_Double_Wert.Active = True
LEVEL2_TXT_Double_Wert.Contents = 0.0
LEVEL2_TXT_Double_Wert.Active = False
LEVEL2_TXT_Date_Wert.Active = True
LEVEL2_TXT_Date_Wert.Contents = "01.01.1970"
LEVEL2_TXT_Date_Wert.Active = False
ElseIf (Instr( 1, LEVEL2_TXT_Datentyp.screencontents, "Double", vbTextCompare ) > 0) Then
LEVEL2_TXT_Text_Wert.Active = True
LEVEL2_TXT_Text_Wert.Contents = ""
LEVEL2_TXT_Text_Wert.Active = False
LEVEL2_TXT_Integer_Wert.Active = True
LEVEL2_TXT_Integer_Wert.Contents = 0
LEVEL2_TXT_Integer_Wert.Active = False
LEVEL2_TXT_Double_Wert.Active = True
LEVEL2_TXT_Date_Wert.Active = True
LEVEL2_TXT_Date_Wert.Contents = "01.01.1970"
LEVEL2_TXT_Date_Wert.Active = False
ElseIf (Instr( 1, LEVEL2_TXT_Datentyp.screencontents, "Date", vbTextCompare ) > 0) Then
LEVEL2_TXT_Text_Wert.Active = True
LEVEL2_TXT_Text_Wert.Contents = ""
LEVEL2_TXT_Text_Wert.Active = False
LEVEL2_TXT_Integer_Wert.Active = True
LEVEL2_TXT_Integer_Wert.Contents = 0
LEVEL2_TXT_Integer_Wert.Active = False
LEVEL2_TXT_Double_Wert.Active = True
LEVEL2_TXT_Double_Wert.Contents = 0.0
LEVEL2_TXT_Double_Wert.Active = False
LEVEL2_TXT_Date_Wert.Active = True
End if
End if
End Sub

View File

@ -0,0 +1,85 @@
' EnableExportWinLineDoc_ButtonControls
' ----------------------------------------------------------------------------
' Diese Subroutine aktiviert Knöpfe im Ribbon und in Fenster.
' Parameter 1 (LEVEL) = Das aktuelle Showlevel übergeben.
' Parameter 2 (CTRLType)= "Static" aktiviert pauschal, "dynamic" aktiviert anhand anderer Laufzeitvariablen.
'
' ----------------------------------------------------------------------------
' 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: 29.06.2021 / MK
' Version Date / Editor: 29.06.2021 / MK
' Version Number: 1.0.0.0
Sub EnableExportWinLineDoc_ButtonControls(LEVEL,CTRLType)
If ((LEVEL = 0) or (LEVEL = "0")) and (CTRLType = "static") Then
LEVEL0_BTN_ABORT.Active = True
ElseIf ((LEVEL = 1) or (LEVEL = "1")) and (CTRLType = "static") Then
LEVEL0_BTN_OK.Active = True
LEVEL0_BTN_EXIT.Active = True
LEVEL1_TAB_LEVEL1_TO_LEVEL1.Active = True
LEVEL1_TAB_LEVEL1_TO_LEVEL2.Active = True
LEVEL1_TAB_LEVEL1_TO_LEVEL3.Active = True
ElseIf ((LEVEL = 2) or (LEVEL = "2")) and (CTRLType = "static") Then
LEVEL0_BTN_OK.Active = True
LEVEL0_BTN_EXIT.Active = True
LEVEL2_TAB_LEVEL2_TO_LEVEL1.Active = True
LEVEL2_TAB_LEVEL2_TO_LEVEL2.Active = True
LEVEL2_TAB_LEVEL2_TO_LEVEL3.Active = True
ElseIf ((LEVEL = 1) or (LEVEL = "1")) and (CTRLType = "dynamic") Then
If (LEVEL1_GRID_CURRENT_GUID = -1) Then
LEVEL0_BTN_ABORT.Active = TRUE
LEVEL0_BTN_SAVE.Active = True
ElseIf (LEVEL1_GRID_CURRENT_ROW > 0) and (LEVEL1_GRID_CURRENT_GUID > 0) Then
LEVEL0_BTN_OK.Active = True
LEVEL0_BTN_NEW.Active = True
LEVEL0_BTN_SAVE.Active = True
LEVEL0_BTN_DELETE.Active = True
ElseIf (LEVEL1_GRID_CURRENT_ROW = 0) and (LEVEL1_GRID_CURRENT_GUID = 0) Then
LEVEL0_BTN_OK.Active = True
LEVEL0_BTN_NEW.Active = True
End if
ElseIf ((LEVEL = 2) or (LEVEL = "2")) and (CTRLType = "dynamic") Then
If (LEVEL2_GRID_CURRENT_GUID = -1) Then
LEVEL0_BTN_ABORT.Active = TRUE
LEVEL0_BTN_SAVE.Active = True
ElseIf (LEVEL2_GRID_CURRENT_ROW > 0) and (LEVEL2_GRID_CURRENT_GUID > 0) Then
LEVEL0_BTN_OK.Active = True
LEVEL0_BTN_NEW.Active = True
LEVEL0_BTN_SAVE.Active = True
LEVEL0_BTN_DELETE.Active = True
ElseIf (LEVEL2_GRID_CURRENT_ROW = 0) and (LEVEL2_GRID_CURRENT_GUID = 0) Then
LEVEL0_BTN_OK.Active = True
LEVEL0_BTN_NEW.Active = True
End if
End if
End Sub

View File

@ -0,0 +1,105 @@
' EnableExportWinLineDoc_InputControls
' ----------------------------------------------------------------------------
' Diese Subroutine aktiviert sämtliche Eingabefelder auf einem Level.
' Parameter 1 (LEVEL) = Das aktuelle Showlevel übergeben.
' Parameter 2 (CTRLType)= "Static" aktiviert pauschal, "dynamic" aktiviert anhand anderer Laufzeitvariablen.
'
' ----------------------------------------------------------------------------
' 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: 17.06.2021 / MD
' Version Date / Editor: 17.06.2021 / MD
' Version Number: 1.0.0.0
Sub EnableExportWinLineDoc_InputControls(LEVEL,CTRLType)
If ((LEVEL = 1) or (LEVEL = "1")) and ((CTRLType = "dynamic") or (CTRLType = "static")) Then
LEVEL1_CHK_Aktiv.Active = true
LEVEL1_TXT_Beschreibung.Active = true
LEVEL1_TXT_Mandant.Active = true
LEVEL1_TXT_WinLineVariable1.Active = true
LEVEL1_TXT_WinLineVariable2.Active = true
LEVEL1_TXT_WinLineVariable3.Active = true
LEVEL1_TXT_WinLineVariable4.Active = true
LEVEL1_TXT_WinLineVariable5.Active = true
LEVEL1_TXT_WinLineVariable6.Active = true
LEVEL1_TXT_WinLineVariable7.Active = true
LEVEL1_TXT_WinLineVariable8.Active = true
LEVEL1_TXT_WinLineVariable9.Active = true
LEVEL1_TXT_WinLineVariable10.Active = true
LEVEL1_TXT_CallMakroPreExport1.Active = true
LEVEL1_TXT_CallMakroPreExport2.Active = true
LEVEL1_TXT_CallMakroPreExport3.Active = true
LEVEL1_TXT_CallMakroPreExport4.Active = true
LEVEL1_TXT_CallMakroPreExport5.Active = true
LEVEL1_TXT_CallMakroPreExport6.Active = true
LEVEL1_TXT_CallMakroPreExport7.Active = true
LEVEL1_TXT_CallMakroPreExport8.Active = true
LEVEL1_TXT_CallMakroPreExport9.Active = true
LEVEL1_TXT_CallMakroPreExport10.Active = true
LEVEL1_TXT_ExportPfad.Active = true
LEVEL1_TXT_ExportDateiname.Active = true
LEVEL1_TXT_ExportDateinameVorschau.Active = true
LEVEL1_TXT_ExportDateiendung.Active = true
LEVEL1_TXT_ExportVersionierung.Active = true
LEVEL1_BTN_VariableEinfuegen1.Active = true
LEVEL1_BTN_VariableEinfuegen2.Active = true
LEVEL1_BTN_VariableEinfuegen3.Active = true
ElseIf ((LEVEL = 2) or (LEVEL = "2")) and (CTRLType = "static") Then
LEVEL2_CHK_Aktiv.Active = True
LEVEL2_TXT_Beschreibung.Active = True
LEVEL2_TXT_Mandant.Active = True
LEVEL2_TXT_Eintragstyp.Active = True
LEVEL2_TXT_Platzhalter.Active = True
LEVEL2_TXT_Datentyp.Active = True
LEVEL2_TXT_Text_Wert.Active = True
LEVEL2_TXT_Integer_Wert.Active = True
LEVEL2_TXT_Double_Wert.Active = True
LEVEL2_TXT_Date_Wert.Active = True
ElseIf ((LEVEL = 2) or (LEVEL = "2")) and (CTRLType = "dynamic") Then
IF (Instr( 1, LEVEL2_TXT_Datentyp.screencontents, "Text", vbTextCompare ) > 0) Then
LEVEL2_TXT_Text_Wert.Active = True
LEVEL2_TXT_Integer_Wert.Active = False
LEVEL2_TXT_Double_Wert.Active = False
LEVEL2_TXT_Date_Wert.Active = False
ElseIf (Instr( 1, LEVEL2_TXT_Datentyp.screencontents, "Integer", vbTextCompare ) > 0) Then
LEVEL2_TXT_Text_Wert.Active = False
LEVEL2_TXT_Integer_Wert.Active = True
LEVEL2_TXT_Double_Wert.Active = False
LEVEL2_TXT_Date_Wert.Active = False
ElseIf (Instr( 1, LEVEL2_TXT_Datentyp.screencontents, "Double", vbTextCompare ) > 0) Then
LEVEL2_TXT_Text_Wert.Active = False
LEVEL2_TXT_Integer_Wert.Active = False
LEVEL2_TXT_Double_Wert.Active = True
LEVEL2_TXT_Date_Wert.Active = False
ElseIf (Instr( 1, LEVEL2_TXT_Datentyp.screencontents, "Date", vbTextCompare ) > 0) Then
LEVEL2_TXT_Text_Wert.Active = False
LEVEL2_TXT_Integer_Wert.Active = False
LEVEL2_TXT_Double_Wert.Active = False
LEVEL2_TXT_Date_Wert.Active = True
End if
End if
End Sub

View File

@ -0,0 +1,107 @@
' GetExportWinLineDoc_Record
' ----------------------------------------------------------------------------
' Diese Subroutine läd Daten in Zwischenvariabelen.
' Parameter 1 (LEVEL) = Das aktuelle Showlevel übergeben.
' Parameter 2 (GRID) = Falls mehrere Grids auf einem Level vorkommen, kann über diesen Parameter nochmals unterscheiden werden.
' Parameter 2 (CURRENT_GUID)= Anhand dieser eindeutgen Nummer wird der Datensatz in der DB identifiziert.
'
' ----------------------------------------------------------------------------
' 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: 14.06.2021 / MK
' Version Date / Editor: 14.06.2021 / MK
' Version Number: 1.0.0.0
Sub GetExportWinLineDoc_Record(LEVEL,GRID,CURRENT_GUID)
If (LEVEL = 1) or (LEVEL = "1") Then
If (GRID = LEVEL1_GRID_ID) Then
SQLQuery_Profile = SQLQuery_Profile_Template
SQLQuery_Profile = Replace(SQLQuery_Profile,"%GUID%",LEVEL1_GRID_CURRENT_GUID)
Set SQLResult_Profile = Conn.Select(SQLQuery_Profile)
If (SQLResult_Profile.RowCount = 1) Then
LEVEL1_TXT_GUID_DBValue = SQLResult_Profile.Value("u000")
LEVEL1_CHK_Aktiv_DBValue = SQLResult_Profile.Value("u001")
LEVEL1_TXT_Beschreibung_DBValue = SQLResult_Profile.Value("u002")
LEVEL1_TXT_Mandant_DBValue = SQLResult_Profile.Value("u003")
LEVEL1_TXT_WinLineVariable1_DBValue = SQLResult_Profile.Value("u004")
LEVEL1_TXT_WinLineVariable2_DBValue = SQLResult_Profile.Value("u005")
LEVEL1_TXT_WinLineVariable3_DBValue = SQLResult_Profile.Value("u006")
LEVEL1_TXT_WinLineVariable4_DBValue = SQLResult_Profile.Value("u007")
LEVEL1_TXT_WinLineVariable5_DBValue = SQLResult_Profile.Value("u008")
LEVEL1_TXT_WinLineVariable6_DBValue = SQLResult_Profile.Value("u009")
LEVEL1_TXT_WinLineVariable7_DBValue = SQLResult_Profile.Value("u010")
LEVEL1_TXT_WinLineVariable8_DBValue = SQLResult_Profile.Value("u011")
LEVEL1_TXT_WinLineVariable9_DBValue = SQLResult_Profile.Value("u012")
LEVEL1_TXT_WinLineVariable10_DBValue = SQLResult_Profile.Value("u013")
LEVEL1_TXT_CallMakroPreExport1_DBValue = SQLResult_Profile.Value("u014")
LEVEL1_TXT_CallMakroPreExport2_DBValue = SQLResult_Profile.Value("u015")
LEVEL1_TXT_CallMakroPreExport3_DBValue = SQLResult_Profile.Value("u016")
LEVEL1_TXT_CallMakroPreExport4_DBValue = SQLResult_Profile.Value("u017")
LEVEL1_TXT_CallMakroPreExport5_DBValue = SQLResult_Profile.Value("u018")
LEVEL1_TXT_CallMakroPreExport6_DBValue = SQLResult_Profile.Value("u019")
LEVEL1_TXT_CallMakroPreExport7_DBValue = SQLResult_Profile.Value("u020")
LEVEL1_TXT_CallMakroPreExport8_DBValue = SQLResult_Profile.Value("u021")
LEVEL1_TXT_CallMakroPreExport9_DBValue = SQLResult_Profile.Value("u022")
LEVEL1_TXT_CallMakroPreExport10_DBValue = SQLResult_Profile.Value("u023")
LEVEL1_TXT_ExportPfad_DBValue = SQLResult_Profile.Value("u024")
LEVEL1_TXT_ExportDateiname_DBValue = SQLResult_Profile.Value("u025")
LEVEL1_TXT_ExportDateinameVorschau_DBValue = SQLResult_Profile.Value("u026")
LEVEL1_TXT_ExportDateiendung_DBValue = SQLResult_Profile.Value("u027")
LEVEL1_TXT_ExportVersionierung_DBValue = SQLResult_Profile.Value("u028")
LEVEL0_TXT_Erstellt_wer_DBValue = SQLResult_Profile.Value("u029")
LEVEL0_TXT_Erstellt_wann_DBValue = SQLResult_Profile.Value("u030")
LEVEL0_TXT_Geaendert_wer_DBValue = SQLResult_Profile.Value("u031")
LEVEL0_TXT_Geaendert_wann_DBValue = SQLResult_Profile.Value("u032")
End if
End If
ElseIf (LEVEL = 2) or (LEVEL = "2") Then
If (GRID = LEVEL2_GRID_ID) Then
SQLQuery_Config = SQLQuery_Config_Template
SQLQuery_Config = Replace(SQLQuery_Config,"%GUID%",LEVEL2_GRID_CURRENT_GUID)
Set SQLResult_Config = Conn.Select(SQLQuery_Config)
If (SQLResult_Config.RowCount = 1) Then
LEVEL2_TXT_GUID_DBValue = SQLResult_Config.Value("u000")
LEVEL2_CHK_Aktiv_DBValue = SQLResult_Config.Value("u001")
LEVEL2_TXT_Beschreibung_DBValue = SQLResult_Config.Value("u002")
LEVEL2_TXT_Mandant_DBValue = SQLResult_Config.Value("u003")
LEVEL2_TXT_Eintragstyp_DBValue = SQLResult_Config.Value("u004")
LEVEL2_TXT_Platzhalter_DBValue = SQLResult_Config.Value("u005")
LEVEL2_TXT_Datentyp_DBValue = SQLResult_Config.Value("u006")
LEVEL2_TXT_Text_Wert_DBValue = SQLResult_Config.Value("u007")
LEVEL2_TXT_Integer_Wert_DBValue = SQLResult_Config.Value("u008")
LEVEL2_TXT_Double_Wert_DBValue = SQLResult_Config.Value("u009")
LEVEL2_TXT_Date_Wert_DBValue = SQLResult_Config.Value("u010")
LEVEL0_TXT_Erstellt_wer_DBValue = SQLResult_Config.Value("u011")
LEVEL0_TXT_Erstellt_wann_DBValue = SQLResult_Config.Value("u012")
LEVEL0_TXT_Geaendert_wer_DBValue = SQLResult_Config.Value("u013")
LEVEL0_TXT_Geaendert_wann_DBValue = SQLResult_Config.Value("u014")
End if
End if
End if
End Sub

View File

@ -0,0 +1,98 @@
' InitializeExportWinLineDoc_CreateVar
' ----------------------------------------------------------------------------
' Diese Subroutine initialisiert die nötigen Variablen.
'
' ----------------------------------------------------------------------------
' 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: 15.06.2021 / MK
' Version Date / Editor: 15.06.2021 / MK
' Version Number: 1.0.0.0
Sub InitializeExportWinLineDoc_CreateVar()
'Storage for custom fields on LEVEL 0
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 90, "1", 64 'Erstellt wer / String
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 91, "6", 16 'Erstellt wann / Datum mit Zeit
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 92, "1", 64 'Geändert wer / String
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 93, "6", 16 'Geändert wann / Datum mit Zeit
'----------------------------------------------------------------------------------------------------------
'Storage for custom fields on LEVEL 1
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 0, "2", 25 'GUID / Integer
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 1, "2", 3 'Aktiv / Integer (bool)
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 2, "1", 512 'Beschreibung / String
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 3, "31", 4 'Mandant / ComboBox
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 4, "1", 128 'WinLine Variable 1 / String
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 5, "1", 128 'WinLine Variable 2 / String
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 6, "1", 128 'WinLine Variable 3 / String
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 7, "1", 128 'WinLine Variable 4 / String
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 8, "1", 128 'WinLine Variable 5 / String
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 9, "1", 128 'WinLine Variable 6 / String
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 10,"1", 128 'WinLine Variable 7 / String
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 11,"1", 128 'WinLine Variable 8 / String
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 12,"1", 128 'WinLine Variable 9 / String
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 13,"1", 128 'WinLine Variable 10 / String
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 14,"31", 50 'Call Makro pre Export 1 / ComboBox
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 15,"31", 50 'Call Makro pre Export 2 / ComboBox
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 16,"31", 50 'Call Makro pre Export 3 / ComboBox
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 17,"31", 50 'Call Makro pre Export 4 / ComboBox
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 18,"31", 50 'Call Makro pre Export 5 / ComboBox
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 19,"31", 50 'Call Makro pre Export 6 / ComboBox
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 20,"31", 50 'Call Makro pre Export 7 / ComboBox
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 21,"31", 50 'Call Makro pre Export 8 / ComboBox
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 22,"31", 50 'Call Makro pre Export 9 / ComboBox
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 23,"31", 50 'Call Makro pre Export 10 / ComboBox
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 24,"1", 256 'Export Pfad / String
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 25,"1", 256 'Export Dateiname / String
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 26,"1", 256 'Export Dateiname Vorschau / String
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 27,"2", 3 'Export Dateiendung / Integer
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 28,"2", 3 'Export Versionierung / Integer
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 99,"1", 255 'GUID / String
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 98,"1", 255 'TabelCounter / String
'----------------------------------------------------------------------------------------------------------
'Storage for custom fields on LEVEL 2
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 50,"2", 25 'GUID / Integer
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 51,"2", 3 'Aktiv / Integer (bool)
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 52,"1", 512 'Beschreibung / String
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 53,"31", 4 'Mandant / ComboBox
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 54,"31", 16 'Eintragstyp / ComboBox
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 55, "1",512 'Platzhalter / String
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 56,"31", 16 'Datentyp / ComboBox
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 57, "1",512 'Text-Wert / String
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 58, "2", 64 'Integer-Wert / Zahl ohne Nachkommastellen
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 59, "4", 64 'Double-Wert / Zahl mit Nachkommastellen
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 60, "6", 64 'Date-Wert / Datum mit Zeit
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 97,"1", 255 'GUID / String
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 96,"1", 255 'TabelCounter / String
'----------------------------------------------------------------------------------------------------------
'Storage for custom fields on LEVEL 3
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 80,"1", 512 'Standard Modul Pfad / String
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 81,"1", 512 'Export-WinLineDoc Modul Pfad / String
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 82,"1", 50 'WebServiceUser / String
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 89,"1",4000 '<Blank> / String
End Sub
'Create Var
'Type Bedeutung
'1 Textvariable (Länge wählbar)
'2 Zahl ohne Nachkommastellen (Integer)
'4 Zahl mit Nachkommastellen (Double)
'6 Datum mit Zeit

View File

@ -0,0 +1,273 @@
' NewExportWinLineDoc_Record
' ----------------------------------------------------------------------------
' Diese Funktion startet die Neuanlage eines Datensatzes oder beendet diese vorzeitig (ohne zu speichern).
' Parameter 1 (LEVEL) = Das aktuelle Showlevel übergeben.
' Parameter 2 (ABORT) = "True" übergeben, wenn die Neuanlage abgebrochen werden soll.
'
' ----------------------------------------------------------------------------
' 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: 15.07.2021 / MK
' Version Date / Editor: 15.07.2021 / MK
' Version Number: 1.0.0.0
Function NewExportWinLineDoc_Record(LEVEL,ABORT)
If (((LEVEL = 1) or (LEVEL = "1")) and (ABORT = False)) Then
'Set Grid vars to empty
LEVEL1_GRID_CURRENT_ROW = 0
LEVEL1_GRID_CURRENT_GUID = 0
LEVEL1_GRID_CURRENT_AKTIV = 0
LEVEL1_GRID_CURRENT_Beschreibung = 0
LEVEL1_GRID_CURRENT_Mandant = 0
'Set Grid cols inactive
LEVEL1_Grid.SetColumnReadOnly LEVEL1_GRID_COLUMN_GUID, true, true
LEVEL1_Grid.SetColumnReadOnly LEVEL1_GRID_COLUMN_AKTIV, true, true
LEVEL1_Grid.SetColumnReadOnly LEVEL1_GRID_COLUMN_BESCHREIBUNG, true, true
LEVEL1_Grid.SetColumnReadOnly LEVEL1_GRID_COLUMN_MANDANT, true, true
'Disable all input controls..
DisableExportWinLineDoc_InputControls CURRENT_LEVEL,"static"
'And enable them again
EnableExportWinLineDoc_InputControls CURRENT_LEVEL,"static"
'-------------------------------------------------------
'Set controls with default values, if there are no old values...
'Old values (ScreenContents) is used for a profile copy
'Always set new profiles to inactive state
LEVEL1_CHK_Aktiv.Contents = ""
LEVEL1_CHK_Aktiv.Contents = "0"
If (LEVEL1_TXT_Beschreibung.ScreenContents = "") Then
LEVEL1_TXT_Beschreibung.Contents = "Neues Profil"
Else
LEVEL1_TXT_Beschreibung.Contents = "Kopie von " & LEVEL1_TXT_Beschreibung.ScreenContents
End if
If (LEVEL1_TXT_Mandant.ScreenContents = "") Then
LEVEL1_TXT_Mandant.Contents = "ALL"
End if
If (LEVEL1_TXT_CallMakroPreExport1.ScreenContents = "") Then
LEVEL1_TXT_CallMakroPreExport1.Contents = "<KEIN MAKRO>"
End if
If (LEVEL1_TXT_CallMakroPreExport2.ScreenContents = "") Then
LEVEL1_TXT_CallMakroPreExport2.Contents = "<KEIN MAKRO>"
End if
If (LEVEL1_TXT_CallMakroPreExport3.ScreenContents = "") Then
LEVEL1_TXT_CallMakroPreExport3.Contents = "<KEIN MAKRO>"
End if
If (LEVEL1_TXT_CallMakroPreExport4.ScreenContents = "") Then
LEVEL1_TXT_CallMakroPreExport4.Contents = "<KEIN MAKRO>"
End if
If (LEVEL1_TXT_CallMakroPreExport5.ScreenContents = "") Then
LEVEL1_TXT_CallMakroPreExport5.Contents = "<KEIN MAKRO>"
End if
If (LEVEL1_TXT_CallMakroPreExport6.ScreenContents = "") Then
LEVEL1_TXT_CallMakroPreExport6.Contents = "<KEIN MAKRO>"
End if
If (LEVEL1_TXT_CallMakroPreExport7.ScreenContents = "") Then
LEVEL1_TXT_CallMakroPreExport7.Contents = "<KEIN MAKRO>"
End if
If (LEVEL1_TXT_CallMakroPreExport8.ScreenContents = "") Then
LEVEL1_TXT_CallMakroPreExport8.Contents = "<KEIN MAKRO>"
End if
If (LEVEL1_TXT_CallMakroPreExport9.ScreenContents = "") Then
LEVEL1_TXT_CallMakroPreExport9.Contents = "<KEIN MAKRO>"
End if
If (LEVEL1_TXT_CallMakroPreExport10.ScreenContents = "") Then
LEVEL1_TXT_CallMakroPreExport10.Contents = "<KEIN MAKRO>"
End if
If (LEVEL1_TXT_ExportPfad.ScreenContents = "") Then
LEVEL1_TXT_ExportPfad.Contents = "%EXPORTPATH%"
End if
If (LEVEL1_TXT_ExportDateiname.ScreenContents = "") Then
LEVEL1_TXT_ExportDateiname.Contents = "%MandantenNr%-%KontoNr%-%Belegnummer%-%Laufnummer%"
End if
If (LEVEL1_TXT_ExportDateinameVorschau.ScreenContents = "") Then
LEVEL1_TXT_ExportDateinameVorschau.Contents = "%MandantenNr%-%KontoNr%-%Belegnummer%-%Laufnummer%"
End if
If (LEVEL1_TXT_ExportDateiendung.ScreenContents = "") Then
LEVEL1_TXT_ExportDateiendung.Contents = "5"
End if
If (LEVEL1_TXT_ExportVersionierung.ScreenContents = "") Then
LEVEL1_TXT_ExportVersionierung.Contents = "9"
End if
'...and set focus to every field once
SetExportWinLineDoc_FocusToRequiredFields CURRENT_LEVEL
'Reset counter, to force SetFiledFocus on next switch
LEVEL1_GRID_CALLCOUNT = 0
'-------------------------------------------------------
'Disable ribbon and menu buttons
DisableExportWinLineDoc_ButtonControls CURRENT_LEVEL,"static"
'To let the save sub knwo, it a new line!
NewExportWinLineDoc_Record = -1
'---------------------------------------------------------------------------------------
'***************************************************************************************
'---------------------------------------------------------------------------------------
ElseIf (((LEVEL = 2) or (LEVEL = "2")) and (ABORT = False)) Then
'Set Grid vars to empty
LEVEL2_GRID_CURRENT_ROW = 0
LEVEL2_GRID_CURRENT_GUID = 0
LEVEL2_GRID_CURRENT_AKTIV = 0
LEVEL2_GRID_CURRENT_Beschreibung = 0
LEVEL2_GRID_CURRENT_Mandant = 0
'Set Grid cols inactive
LEVEL2_Grid.SetColumnReadOnly LEVEL2_GRID_COLUMN_GUID, true, true
LEVEL2_Grid.SetColumnReadOnly LEVEL2_GRID_COLUMN_AKTIV, true, true
LEVEL2_Grid.SetColumnReadOnly LEVEL2_GRID_COLUMN_BESCHREIBUNG, true, true
LEVEL2_Grid.SetColumnReadOnly LEVEL2_GRID_COLUMN_MANDANT, true, true
'Disable all input controls..
DisableExportWinLineDoc_InputControls CURRENT_LEVEL,"static"
'And enable them again
EnableExportWinLineDoc_InputControls CURRENT_LEVEL,"static"
'-------------------------------------------------------
'Set controls with default values, if there are no old values...
'Old values (ScreenContents) is used for a profile copy
'Always set new profiles to inactive state
LEVEL2_CHK_Aktiv.Contents = ""
LEVEL2_CHK_Aktiv.Contents = "0"
If (LEVEL2_TXT_Beschreibung.ScreenContents = "") Then
LEVEL2_TXT_Beschreibung.Contents = "Neues Profil"
Else
LEVEL2_TXT_Beschreibung.Contents = "Kopie von " & LEVEL2_TXT_Beschreibung.ScreenContents
End if
If (LEVEL2_TXT_Mandant.ScreenContents = "") Then
LEVEL2_TXT_Mandant.Contents = "ALL"
End if
If (LEVEL2_TXT_Eintragstyp.ScreenContents = "") Then
LEVEL2_TXT_Eintragstyp.Contents = "CUSTOM_VARIABLE"
End if
If (LEVEL2_TXT_Platzhalter.ScreenContents = "") Then
LEVEL2_TXT_Platzhalter.Contents = "%PLATZHALTER%"
End if
If (LEVEL2_TXT_Datentyp.ScreenContents = "") Then
LEVEL2_TXT_Datentyp.Contents = "TEXT"
End if
IF (Instr( 1, LEVEL2_TXT_Datentyp.screencontents, "Text", vbTextCompare ) > 0) Then
If (LEVEL2_TXT_Text_Wert.ScreenContents = "") Then
LEVEL2_TXT_Text_Wert.Contents = "c:\WinLine\Dokumentablage"
End if
End if
If (Instr( 1, LEVEL2_TXT_Datentyp.screencontents, "Integer", vbTextCompare ) > 0) Then
If (LEVEL2_TXT_Integer_Wert.ScreenContents = "") Then
LEVEL2_TXT_Integer_Wert.Contents = 0
End if
End if
If (Instr( 1, LEVEL2_TXT_Datentyp.screencontents, "Double", vbTextCompare ) > 0) Then
If (LEVEL2_TXT_Double_Wert.ScreenContents = "") Then
LEVEL2_TXT_Double_Wert.Contents = 0.0
End if
End if
If (Instr( 1, LEVEL2_TXT_Datentyp.screencontents, "Date", vbTextCompare ) > 0) Then
If (LEVEL2_TXT_Date_Wert.ScreenContents = "") Then
LEVEL2_TXT_Date_Wert.Contents = "01.01.1970"
End if
End if
'...and set focus to every field once
SetExportWinLineDoc_FocusToRequiredFields CURRENT_LEVEL
'SPECIAL: set data type fields depending on selcted type on/off
DisableExportWinLineDoc_InputControls CURRENT_LEVEL,"dynamic"
'Reset counter, to force SetFiledFocus on next switch
LEVEL2_GRID_CALLCOUNT = 0
'-------------------------------------------------------
'Disable ribbon and menu buttons
DisableExportWinLineDoc_ButtonControls CURRENT_LEVEL,"static"
'To let the save sub knwo, it a new line!
NewExportWinLineDoc_Record = -1
'If new line was aborted on tab / level 1
ElseIf ((LEVEL = 1) or (LEVEL = "1") and (ABORT = True)) Then
LEVEL1_Grid.SetColumnReadOnly LEVEL1_GRID_COLUMN_GUID, False, False
LEVEL1_Grid.SetColumnReadOnly LEVEL1_GRID_COLUMN_AKTIV, False, False
LEVEL1_Grid.SetColumnReadOnly LEVEL1_GRID_COLUMN_BESCHREIBUNG, False, False
LEVEL1_Grid.SetColumnReadOnly LEVEL1_GRID_COLUMN_MANDANT, False, False
'Set Grid vars to empty
LEVEL1_GRID_CURRENT_ROW = 0
LEVEL1_GRID_CURRENT_GUID = 0
LEVEL1_GRID_CURRENT_AKTIV = 0
LEVEL1_GRID_CURRENT_Beschreibung = 0
LEVEL1_GRID_CURRENT_Mandant = 0
'And enable tabs again
EnableExportWinLineDoc_ButtonControls CURRENT_LEVEL,"static"
EnableExportWinLineDoc_ButtonControls CURRENT_LEVEL,"dynamic"
'Focus Grid and line again, wil trigger to set LEVEL1_GRID_CURRENT_GUID again
MacroCommands.MSetFieldFocus MAIN_WINDOW_ID,LEVEL1_GRID_ID
'After reloading, go through all fields again
If ((LEVEL1_GRID_CURRENT_GUID > 0) and (LEVEL1_GRID_CURRENT_ROW > 0)) Then
SetExportWinLineDoc_FocusToRequiredFields CURRENT_LEVEL
End if
'Return GUID from selected line
NewExportWinLineDoc_Record = LEVEL1_GRID_CURRENT_GUID
'If new line was aborted on tab / level 2
ElseIf ((LEVEL = 2) or (LEVEL = "2") and (ABORT = True)) Then
LEVEL2_Grid.SetColumnReadOnly LEVEL2_GRID_COLUMN_GUID, False, False
LEVEL2_Grid.SetColumnReadOnly LEVEL2_GRID_COLUMN_AKTIV, False, False
LEVEL2_Grid.SetColumnReadOnly LEVEL2_GRID_COLUMN_BESCHREIBUNG, False, False
LEVEL2_Grid.SetColumnReadOnly LEVEL2_GRID_COLUMN_MANDANT, False, False
LEVEL2_GRID_CURRENT_ROW = 0
LEVEL2_GRID_CURRENT_GUID = 0
LEVEL2_GRID_CURRENT_AKTIV = 0
LEVEL2_GRID_CURRENT_Beschreibung = 0
LEVEL2_GRID_CURRENT_Mandant = 0
'And enable tabs again
EnableExportWinLineDoc_ButtonControls CURRENT_LEVEL,"static"
EnableExportWinLineDoc_ButtonControls CURRENT_LEVEL,"dynamic"
'Focus Grid and line again, wil trigger to set LEVEL2_GRID_CURRENT_GUID again
MacroCommands.MSetFieldFocus MAIN_WINDOW_ID,LEVEL2_GRID_ID
'After reloading, go through all fields again
If ((LEVEL2_GRID_CURRENT_GUID > 0) and (LEVEL2_GRID_CURRENT_ROW > 0)) Then
SetExportWinLineDoc_FocusToRequiredFields CURRENT_LEVEL
End if
'Return GUID from selected line
NewExportWinLineDoc_Record = LEVEL2_GRID_CURRENT_GUID
End If
End Function

View File

@ -0,0 +1,166 @@
' SetExportWinLineDoc_ComboBoxControls
' ----------------------------------------------------------------------------
' Diese Funktion liefert Werte, um Auswahlboxen zu füllen.
' Parameter 1 (CTRLType)= Name oder Typ des Controls welches gefüllt werden soll.
'
' ----------------------------------------------------------------------------
' 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: 16.07.2021 / MK
' Version Date / Editor: 16.07.2021 / MK
' Version Number: 1.0.0.0
Function SetExportWinLineDoc_ComboBoxControls(CMBType)
if (CMBType = "Mandant") Then
Set SQLResult_Mandators = Conn.Select(SQLQuery_Mandators)
If (SQLResult_Mandators.RowCount) > 0 Then
Mandators = 0
Mandators = "ALL :Alle Mandanten;"
'----------------------------------------------------
'Inital Value before "NextRecord"
Mandators = Mandators & SQLResult_Mandators.value("c000")
For Loop1 = Len(SQLResult_Mandators.value("c000"))+1 To 3
Mandators = Mandators & " "
Next
Mandators = Mandators & ":" & SQLResult_Mandators.value("c003") & ";"
'----------------------------------------------------
Do
'Loop for every combobox value
If (SQLResult_Mandators.NextRecord = True) Then
Mandators = Mandators & SQLResult_Mandators.value("c000")
'Inital Value before "NextRecord"
For Loop2 = Len(SQLResult_Mandators.value("c000"))+1 To 3
Mandators = Mandators & " "
Next
Mandators = Mandators & ":" & SQLResult_Mandators.value("c003") & ";"
Else
'To remove last ";"
Mandators = LEFT(Mandators, Len(Mandators)-1)
Exit Do
End If
Loop
Else
Mandators = "ALL :Alle Mandanten"
End If
SetExportWinLineDoc_ComboBoxControls = Mandators
ElseIf (CMBType = "ProgramMakros") Then
Set SQLResult_ProgramMakros = Conn.Select(SQLQuery_ProgramMakros)
If (SQLResult_ProgramMakros.RowCount) > 0 Then
ProgramMakros = ""
'----------------------------------------------------
'Inital Value before "NextRecord"
ProgramMakro = ""
ProgramMakro = SQLResult_ProgramMakros.value("c000")
ProgramMakro = Split(ProgramMakro,"@")
ProgramMakros = ProgramMakros & ProgramMakro(0)
For Loop1 = Len(SQLResult_ProgramMakros.value("c000"))+1 To 3
ProgramMakros = ProgramMakros & " "
Next
ProgramMakros = ProgramMakros & ":;"
'----------------------------------------------------
Do
'Loop for every combobox value
If (SQLResult_ProgramMakros.NextRecord = True) Then
ProgramMakro = ""
ProgramMakro = SQLResult_ProgramMakros.value("c000")
ProgramMakro = Split(ProgramMakro,"@")
ProgramMakros = ProgramMakros & ProgramMakro(0)
'Inital Value before "NextRecord"
For Loop2 = Len(SQLResult_ProgramMakros.value("c000"))+1 To 3
ProgramMakros = ProgramMakros & " "
Next
ProgramMakros = ProgramMakros & ":;"
Else
'To remove last ";"
ProgramMakros = LEFT(ProgramMakros, Len(ProgramMakros)-1)
Exit Do
End If
Loop
Else
ProgramMakros = "<KEIN MAKRO>:"
End If
SetExportWinLineDoc_ComboBoxControls = ProgramMakros
ElseIf (CMBType = "Dateiendung") Then
Dateiendungen = ""
Dateiendungen = Dateiendungen & "0:Export als SPL - WinLine SPOOL-Format;"
Dateiendungen = Dateiendungen & "1:Export als MHT - Multipurpose Internet Mail Extension HTML Datei;"
Dateiendungen = Dateiendungen & "4:Export als SPL - WinLine SPOOL-Format Version 2.0 (altes Format);"
Dateiendungen = Dateiendungen & "5:Export als PDF - Portable Document Format - Adobe PDF;"
Dateiendungen = Dateiendungen & "6:Export als rtf/doc - WordRTF"
SetExportWinLineDoc_ComboBoxControls = Dateiendungen
ElseIf (CMBType = "Versionierung") Then
Versionierung = ""
Versionierung = Versionierung & "0:Abbruch, wenn Datei bereits vorhanden;"
Versionierung = Versionierung & "1:Überschreibe, wenn Datei bereits vorhanden;"
Versionierung = Versionierung & "2:Zusammenführen, wenn Datei bereits vorhanden (nur PDF);"
Versionierung = Versionierung & "9:Versioniere, wenn Datei bereits vorhanden;"
SetExportWinLineDoc_ComboBoxControls = Versionierung
ElseIf (CMBType = "Eintragstyp") Then
Eintragstyp = ""
Eintragstyp = Eintragstyp & "CUSTOM_VARIABLE:"
SetExportWinLineDoc_ComboBoxControls = Eintragstyp
ElseIf (CMBType = "Datentyp") Then
Datentyp = ""
Datentyp = Datentyp & "TEXT:;"
Datentyp = Datentyp & "INTEGER:;"
Datentyp = Datentyp & "DOUBLE:;"
Datentyp = Datentyp & "DATE:"
SetExportWinLineDoc_ComboBoxControls = Datentyp
Else
SetExportWinLineDoc_ComboBoxControls = "<ERROR>"
End if
End Function

View File

@ -0,0 +1,60 @@
' SetExportWinLineDoc_FocusToRequiredFields
' ----------------------------------------------------------------------------
' Diese Subroutine geht einmal durch sämtliche MUSS-Felder durch, damit ein User nicht manuell durchklicken muss.
' Parameter 1 (LEVEL) = Das aktuelle Showlevel übergeben.
'
' ----------------------------------------------------------------------------
' 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: 30.06.2021 / MK
' Version Date / Editor: 30.06.2021 / MK
' Version Number: 1.0.0.0
Sub SetExportWinLineDoc_FocusToRequiredFields(LEVEL)
If (LEVEL = 1) or (LEVEL = "1") Then
'As long focusing fields, prevent someone interrups by switching tabs/levels
LEVEL1_TAB_LEVEL1_TO_LEVEL1.Active = False
LEVEL1_TAB_LEVEL1_TO_LEVEL2.Active = False
MacroCommands.MSetFieldFocus MAIN_WINDOW_ID, LEVEL1_GRID_ID
MacroCommands.MSetFieldFocus MAIN_WINDOW_ID, LEVEL1_TXT_ExportVersionierung_ID
MacroCommands.MSetFieldFocus MAIN_WINDOW_ID, LEVEL1_TXT_ExportDateiendung_ID
MacroCommands.MSetFieldFocus MAIN_WINDOW_ID, LEVEL1_TXT_ExportDateinameVorschau_ID
MacroCommands.MSetFieldFocus MAIN_WINDOW_ID, LEVEL1_TXT_ExportDateiname_ID
MacroCommands.MSetFieldFocus MAIN_WINDOW_ID, LEVEL1_TXT_ExportPfad_ID
MacroCommands.MSetFieldFocus MAIN_WINDOW_ID, LEVEL1_TXT_Mandant_ID
MacroCommands.MSetFieldFocus MAIN_WINDOW_ID, LEVEL1_TXT_Beschreibung_ID
LEVEL1_TAB_LEVEL1_TO_LEVEL1.Active = True
LEVEL1_TAB_LEVEL1_TO_LEVEL2.Active = True
'--------------------------------------------------------------------------------------------------------------------------------------------
ElseIf (LEVEL = 2) or (LEVEL = "2") Then
'As long focusing fields, prevent someone interrups by switching tabs/levels
LEVEL2_TAB_LEVEL2_TO_LEVEL1.Active = False
LEVEL2_TAB_LEVEL2_TO_LEVEL2.Active = False
MacroCommands.MSetFieldFocus MAIN_WINDOW_ID, LEVEL2_GRID_ID
MacroCommands.MSetFieldFocus MAIN_WINDOW_ID, LEVEL2_TXT_Eintragstyp_ID
MacroCommands.MSetFieldFocus MAIN_WINDOW_ID, LEVEL2_TXT_Platzhalter_ID
MacroCommands.MSetFieldFocus MAIN_WINDOW_ID, LEVEL2_TXT_Datentyp_ID
MacroCommands.MSetFieldFocus MAIN_WINDOW_ID, LEVEL2_TXT_Mandant_ID
MacroCommands.MSetFieldFocus MAIN_WINDOW_ID, LEVEL2_TXT_Beschreibung_ID
LEVEL2_TAB_LEVEL2_TO_LEVEL1.Active = True
LEVEL2_TAB_LEVEL2_TO_LEVEL2.Active = True
End if
End Sub

View File

@ -0,0 +1,166 @@
' SetExportWinLineDoc_InputControls
' ----------------------------------------------------------------------------
' Diese Subroutine füllt Controls in der GUI (anhand zuvor gesetzter Zwischenvariablen):
' Parameter 1 (LEVEL) = Das aktuelle Showlevel übergeben.
' Parameter 2 (CTRLType)= "Static" setzt pauschal, "dynamic" setzt anhand anderer Laufzeitvariablen, oder "clear" leert die Felder.
'
' ----------------------------------------------------------------------------
' 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: 16.06.2021 / MK
' Version Date / Editor: 16.06.2021 / MK
' Version Number: 1.0.0.0
Sub SetExportWinLineDoc_InputControls(LEVEL,CTRLType)
If ((LEVEL = 1) or (LEVEL = "1")) and ((CTRLType = "dynamic") or (CTRLType = "static")) Then
'Very important to set a checkbox by "" at first
LEVEL1_CHK_Aktiv.Contents = ""
LEVEL1_CHK_Aktiv.Contents = cstr(LEVEL1_CHK_Aktiv_DBValue)
LEVEL1_TXT_Beschreibung.Contents = cstr(LEVEL1_TXT_Beschreibung_DBValue)
LEVEL1_TXT_Mandant.Contents = cstr(LEVEL1_TXT_Mandant_DBValue)
LEVEL1_TXT_WinLineVariable1.Contents = cstr(LEVEL1_TXT_WinLineVariable1_DBValue)
LEVEL1_TXT_WinLineVariable2.Contents = cstr(LEVEL1_TXT_WinLineVariable2_DBValue)
LEVEL1_TXT_WinLineVariable3.Contents = cstr(LEVEL1_TXT_WinLineVariable3_DBValue)
LEVEL1_TXT_WinLineVariable4.Contents = cstr(LEVEL1_TXT_WinLineVariable4_DBValue)
LEVEL1_TXT_WinLineVariable5.Contents = cstr(LEVEL1_TXT_WinLineVariable5_DBValue)
LEVEL1_TXT_WinLineVariable6.Contents = cstr(LEVEL1_TXT_WinLineVariable6_DBValue)
LEVEL1_TXT_WinLineVariable7.Contents = cstr(LEVEL1_TXT_WinLineVariable7_DBValue)
LEVEL1_TXT_WinLineVariable8.Contents = cstr(LEVEL1_TXT_WinLineVariable8_DBValue)
LEVEL1_TXT_WinLineVariable9.Contents = cstr(LEVEL1_TXT_WinLineVariable9_DBValue)
LEVEL1_TXT_WinLineVariable10.Contents = cstr(LEVEL1_TXT_WinLineVariable10_DBValue)
LEVEL1_TXT_CallMakroPreExport1.contents = cstr(LEVEL1_TXT_CallMakroPreExport1_DBValue)
LEVEL1_TXT_CallMakroPreExport2.contents = cstr(LEVEL1_TXT_CallMakroPreExport2_DBValue)
LEVEL1_TXT_CallMakroPreExport3.contents = cstr(LEVEL1_TXT_CallMakroPreExport3_DBValue)
LEVEL1_TXT_CallMakroPreExport4.contents = cstr(LEVEL1_TXT_CallMakroPreExport4_DBValue)
LEVEL1_TXT_CallMakroPreExport5.contents = cstr(LEVEL1_TXT_CallMakroPreExport5_DBValue)
LEVEL1_TXT_CallMakroPreExport6.contents = cstr(LEVEL1_TXT_CallMakroPreExport6_DBValue)
LEVEL1_TXT_CallMakroPreExport7.contents = cstr(LEVEL1_TXT_CallMakroPreExport7_DBValue)
LEVEL1_TXT_CallMakroPreExport8.contents = cstr(LEVEL1_TXT_CallMakroPreExport8_DBValue)
LEVEL1_TXT_CallMakroPreExport9.contents = cstr(LEVEL1_TXT_CallMakroPreExport9_DBValue)
LEVEL1_TXT_CallMakroPreExport10.contents = cstr(LEVEL1_TXT_CallMakroPreExport10_DBValue)
LEVEL1_TXT_ExportPfad.Contents = cstr(LEVEL1_TXT_ExportPfad_DBValue)
LEVEL1_TXT_ExportDateiname.Contents = cstr(LEVEL1_TXT_ExportDateiname_DBValue)
LEVEL1_TXT_ExportDateinameVorschau.Contents = cstr(LEVEL1_TXT_ExportDateinameVorschau_DBValue)
LEVEL1_TXT_ExportDateiendung.Contents = cstr(LEVEL1_TXT_ExportDateiendung_DBValue)
LEVEL1_TXT_ExportVersionierung.Contents = cstr(LEVEL1_TXT_ExportVersionierung_DBValue)
ElseIf ((LEVEL = 1) or (LEVEL = "1")) and (CTRLType = "clear") Then
'Very important to set a checkbox by "" at first
LEVEL1_CHK_Aktiv.Contents = ""
LEVEL1_CHK_Aktiv.Contents = cstr(0)
LEVEL1_TXT_Beschreibung.Contents = cstr("")
LEVEL1_TXT_Mandant.Contents = cstr("ALL")
LEVEL1_TXT_WinLineVariable1.Contents = cstr("")
LEVEL1_TXT_WinLineVariable2.Contents = cstr("")
LEVEL1_TXT_WinLineVariable3.Contents = cstr("")
LEVEL1_TXT_WinLineVariable4.Contents = cstr("")
LEVEL1_TXT_WinLineVariable5.Contents = cstr("")
LEVEL1_TXT_WinLineVariable6.Contents = cstr("")
LEVEL1_TXT_WinLineVariable7.Contents = cstr("")
LEVEL1_TXT_WinLineVariable8.Contents = cstr("")
LEVEL1_TXT_WinLineVariable9.Contents = cstr("")
LEVEL1_TXT_WinLineVariable10.Contents = cstr("")
LEVEL1_TXT_CallMakroPreExport1.contents = cstr("<KEIN MAKRO>")
LEVEL1_TXT_CallMakroPreExport2.contents = cstr("<KEIN MAKRO>")
LEVEL1_TXT_CallMakroPreExport3.contents = cstr("<KEIN MAKRO>")
LEVEL1_TXT_CallMakroPreExport4.contents = cstr("<KEIN MAKRO>")
LEVEL1_TXT_CallMakroPreExport5.contents = cstr("<KEIN MAKRO>")
LEVEL1_TXT_CallMakroPreExport6.contents = cstr("<KEIN MAKRO>")
LEVEL1_TXT_CallMakroPreExport7.contents = cstr("<KEIN MAKRO>")
LEVEL1_TXT_CallMakroPreExport8.contents = cstr("<KEIN MAKRO>")
LEVEL1_TXT_CallMakroPreExport9.contents = cstr("<KEIN MAKRO>")
LEVEL1_TXT_CallMakroPreExport10.contents = cstr("<KEIN MAKRO>")
LEVEL1_TXT_ExportPfad.Contents = cstr("")
LEVEL1_TXT_ExportDateiname.Contents = cstr("")
LEVEL1_TXT_ExportDateinameVorschau.Contents = cstr("")
LEVEL1_TXT_ExportDateiendung.Contents = cstr("5")
LEVEL1_TXT_ExportVersionierung.Contents = cstr("9")
'-------------------------------------------------------------------------------------------
ElseIf ((LEVEL = 2) or (LEVEL = "2")) and (CTRLType = "static") Then
'Very important to set a checkbox by "" at first
LEVEL2_CHK_Aktiv.Contents = ""
LEVEL2_CHK_Aktiv.Contents = cstr(LEVEL2_CHK_Aktiv_DBValue)
LEVEL2_TXT_Beschreibung.Contents = cstr(LEVEL2_TXT_Beschreibung_DBValue)
LEVEL2_TXT_Mandant.Contents = cstr(LEVEL2_TXT_Mandant_DBValue)
LEVEL2_TXT_Eintragstyp.Contents = cstr(LEVEL2_TXT_Eintragstyp_DBValue)
LEVEL2_TXT_Platzhalter.Contents = cstr(LEVEL2_TXT_Platzhalter_DBValue)
LEVEL2_TXT_Datentyp.Contents = cstr(LEVEL2_TXT_Datentyp_DBValue)
LEVEL2_TXT_Text_Wert.Contents = cstr(LEVEL2_TXT_Text_Wert_DBValue)
LEVEL2_TXT_Integer_Wert.Contents = CLng(LEVEL2_TXT_Integer_Wert_DBValue)
LEVEL2_TXT_Double_Wert.Contents = cdbl(LEVEL2_TXT_Double_Wert_DBValue)
IF (LEVEL2_TXT_Date_Wert_DBValue <> "") Then
LEVEL2_TXT_Date_Wert.Contents = cdate(LEVEL2_TXT_Date_Wert_DBValue)
else
LEVEL2_TXT_Date_Wert.Contents = "01.01.1970"
end if
ElseIf ((LEVEL = 2) or (LEVEL = "2")) and (CTRLType = "clear") Then
LEVEL2_CHK_Aktiv.Contents = ""
LEVEL2_CHK_Aktiv.Contents = cstr(0)
LEVEL2_TXT_Beschreibung.Contents = cstr("")
LEVEL2_TXT_Mandant.Contents = cstr("ALL")
LEVEL2_TXT_Eintragstyp.Contents = cstr("CUSTOM_VARIABLE")
LEVEL2_TXT_Platzhalter.Contents = cstr("")
LEVEL2_TXT_Datentyp.Contents = cstr("TEXT")
LEVEL2_TXT_Text_Wert.Contents = cstr("")
LEVEL2_TXT_Integer_Wert.Contents = CLng(0)
LEVEL2_TXT_Double_Wert.Contents = cdbl(0.0)
LEVEL2_TXT_Date_Wert.Contents = cdate("01.01.1970")
ElseIf ((LEVEL = 2) or (LEVEL = "2")) and (CTRLType = "dynamic") Then
LEVEL2_CHK_Aktiv.Contents = ""
LEVEL2_CHK_Aktiv.Contents = cstr(LEVEL2_CHK_Aktiv_DBValue)
LEVEL2_TXT_Beschreibung.Contents = cstr(LEVEL2_TXT_Beschreibung_DBValue)
LEVEL2_TXT_Mandant.Contents = cstr(LEVEL2_TXT_Mandant_DBValue)
LEVEL2_TXT_Eintragstyp.Contents = cstr(LEVEL2_TXT_Eintragstyp_DBValue)
LEVEL2_TXT_Platzhalter.Contents = cstr(LEVEL2_TXT_Platzhalter_DBValue)
LEVEL2_TXT_Datentyp.Contents = cstr(LEVEL2_TXT_Datentyp_DBValue)
IF (Instr( 1, LEVEL2_TXT_Datentyp.screencontents, "Text", vbTextCompare ) > 0) Then
LEVEL2_TXT_Text_Wert.Contents = cstr(LEVEL2_TXT_Text_Wert_DBValue)
ElseIf (Instr( 1, LEVEL2_TXT_Datentyp.screencontents, "Integer", vbTextCompare ) > 0) Then
LEVEL2_TXT_Integer_Wert.Contents = CLng(LEVEL2_TXT_Integer_Wert_DBValue)
ElseIf (Instr( 1, LEVEL2_TXT_Datentyp.screencontents, "Double", vbTextCompare ) > 0) Then
LEVEL2_TXT_Double_Wert.Contents = cdbl(LEVEL2_TXT_Double_Wert_DBValue)
ElseIf (Instr( 1, LEVEL2_TXT_Datentyp.screencontents, "Date", vbTextCompare ) > 0) Then
IF (LEVEL2_TXT_Date_Wert_DBValue <> "") Then
LEVEL2_TXT_Date_Wert.Contents = cdate(LEVEL2_TXT_Date_Wert_DBValue)
else
LEVEL2_TXT_Date_Wert.Contents = "01.01.1970"
end if
End if
End if
End Sub

View File

@ -0,0 +1,101 @@
' DD-INSERT_LANGBESCHINT_INTO_BELEGERFASSUNG
' ----------------------------------------------------------------------------
' Diese Subroutine läd Daten für reine Anzeigefelder.
' Parameter 1 (LEVEL) = Das aktuelle Showlevel übergeben.
'
' ----------------------------------------------------------------------------
' 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: 22.06.2021 / MD
' Version Date / Editor: 22.06.2021 / MD
' Version Number: 1.0.0.0
Sub SetExportWinLineDoc_ReadOnlyControls(LEVEL)
If (LEVEL = 1) or (LEVEL = "1") Then
'Current selected line in grid 1
IF (cint(LEVEL1_TXT_GUID_DBValue) > 0) Then
LEVEL1_TXT_GUID.Contents = "GUID: " & cstr(LEVEL1_TXT_GUID_DBValue)
Else
LEVEL1_TXT_GUID.Contents = "GUID: <0>"
End if
'Line Counter in grid 1
If (LEVEL1_Grid.LineCount > 0) Then
LEVEL1_TXT_TabelCounter.Contents = (Cstr(LEVEL1_Grid.LineCount) & " Zuordnungen gefunden")
Else
LEVEL1_TXT_TabelCounter.Contents = "Keine Zuordnungen gefunden"
End if
ElseIf (LEVEL = 2) or (LEVEL = "2") Then
'Current selected line in grid 2
IF (cint(LEVEL2_TXT_GUID_DBValue) > 0) Then
LEVEL2_TXT_GUID.Contents = "GUID: " & cstr(LEVEL2_TXT_GUID_DBValue)
Else
LEVEL2_TXT_GUID.Contents = "GUID: <0>"
End if
'Line Counter in grid 2
If (LEVEL2_Grid.LineCount > 0) Then
LEVEL2_TXT_TabelCounter.Contents = (Cstr(LEVEL2_Grid.LineCount) & " Zuordnungen gefunden")
Else
LEVEL2_TXT_TabelCounter.Contents = "Keine Zuordnungen gefunden"
End if
ElseIf (LEVEL = 3) or (LEVEL = "3") Then
LEVEL3_TXT_Standard_Modul_Path.Contents = ModuleDefaultSourcePath
LEVEL3_TXT_EWLD_Modul_Path.Contents = ModuleExportWinLineDocSourcePath
LEVEL3_TXT_WebServiceUser.Contents = WebServiceUser
LEVEL3_TXT_Blank.active = true
LEVEL3_TXT_Blank.contents = " "
End if
'------------------------------------------------------------------------------------------------------
'Definitely, does not matter tab / level 1 or 2 set these fields...
If (((LEVEL = 1) or (LEVEL = "1")) and (LEVEL1_GRID_CURRENT_GUID > 0)) or (((LEVEL = 2) or (LEVEL = "2")) and (LEVEL2_GRID_CURRENT_GUID > 0)) Then
IF ((LEVEL0_TXT_Erstellt_wer_DBValue > empty) and (LEVEL0_TXT_Erstellt_wer_DBValue <> "")) Then
LEVEL0_TXT_Erstellt_wer.Contents = cstr(LEVEL0_TXT_Erstellt_wer_DBValue)
Else
LEVEL0_TXT_Erstellt_wer.Contents = NULL
End if
'------------------------------------------------------------------------------------------------------
IF ((LEVEL0_TXT_Erstellt_wann_DBValue > empty) and (LEVEL0_TXT_Erstellt_wann_DBValue <> "")) Then
LEVEL0_TXT_Erstellt_wann.Contents = cdate(LEVEL0_TXT_Erstellt_wann_DBValue)
Else
LEVEL0_TXT_Erstellt_wann.Contents = NULL
End if
'------------------------------------------------------------------------------------------------------
IF ((LEVEL0_TXT_Geaendert_wer_DBValue > empty) and (LEVEL0_TXT_Geaendert_wer_DBValue <> "")) Then
LEVEL0_TXT_Geaendert_wer.Contents = cstr(LEVEL0_TXT_Geaendert_wer_DBValue)
Else
LEVEL0_TXT_Geaendert_wer.Contents = NULL
End if
'------------------------------------------------------------------------------------------------------
IF ((LEVEL0_TXT_Geaendert_wann_DBValue > empty) and (LEVEL0_TXT_Geaendert_wann_DBValue <> "")) Then
LEVEL0_TXT_Geaendert_wann.Contents = cdate(LEVEL0_TXT_Geaendert_wann_DBValue)
Else
LEVEL0_TXT_Geaendert_wann.contents = NULL
End if
'But if no valid line was selected...
Elseif (LEVEL <> 3) and (LEVEL <> "3") Then
LEVEL0_TXT_Erstellt_wer.Contents = NULL
LEVEL0_TXT_Erstellt_wann.Contents = NULL
LEVEL0_TXT_Geaendert_wer.Contents = NULL
LEVEL0_TXT_Geaendert_wann.contents = NULL
End if
End sub

View File

@ -0,0 +1,168 @@
' SetExportWinLineDoc_SQLData
' ----------------------------------------------------------------------------
' Diese Subroutine füllt eine Tabelle (Grid) mit Daten
' Parameter 1 (LEVEL) = Das aktuelle Showlevel übergeben.
' Parameter 2 (BUTTON) = Die ID des betätigten Knopfs.
'
' ----------------------------------------------------------------------------
' 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: 15.07.2021 / MK
' Version Date / Editor: 15.07.2021 / MK
' Version Number: 1.0.0.0
Sub SetExportWinLineDoc_SQLData(LEVEL,BUTTON)
If (BUTTON = LEVEL3_BTN_Restore_Profiles_ID) Then
IF (FileSystemObject.FileExists(TemplateExportWinLineDoc_Profiles_File)) Then
Set SQLResult_Profiles = Conn.Select(SQLQuery_Profiles_Default)
If (SQLResult_Profiles.RowCount) > 0 Then
MsgBoxResult = MsgBox ("Wenn Sie fortfahren, werden die Auslieferungsprofile gelöscht und neu angelegt!" & vbCrLf & vbCrLf & _
"Änderungen an diesen gehen verloren!" & vbCrLf & vbCrLf & _
"Der Vorgang kann NICHT Rückgängig gemacht werden!" & vbCrLf & vbCrLf & _
"Möchten Sie fortfahren?",vbYesNo+vbCritical,DEFAULT_TITLE & " - ACHTUNG! ACHTUNG!")
If (MsgBoxResult = 6) Then
SQLResult_Profiles = Conn.ExecuteSQL(SQLDelete_Profiles)
LEVEL1_GRID_CURRENT_ROW = 0
LEVEL1_GRID_CURRENT_GUID = 0
LEVEL1_GRID_CURRENT_AKTIV = 0
LEVEL1_GRID_CURRENT_Beschreibung = 0
LEVEL1_GRID_CURRENT_Mandant = 0
If (SQLResult_Profiles = true) Then
'After the delete insert
InsertExportWinLineDoc_SQLData LEVEL,TemplateExportWinLineDoc_Profiles_File
Else
MsgBox "Der Löschvorgang ist fehlgeschlagen!" & vbCrLf & _
"Bitte informieren Sie Ihren Administrator!" & vbCrLf & _
"",vbOkayOnly+vbCritical,DEFAULT_TITLE & " - Fehler!"
SQLResult_Profiles = 0
End if
Else
MsgBox "Der Vorgang wurde abgebrochen!",vbOkayOnly+vbInformation,DEFAULT_TITLE
End if
Else
InsertExportWinLineDoc_SQLData LEVEL,TemplateExportWinLineDoc_Profiles_File
End If
Else
MsgBox "Die Vorlagen-Datei wurde nicht gefunden!" & vbCrLf & vbCrLf &_
TemplateExportWinLineDoc_Profiles_File & vbCrLf & _
"",vbYesNo+vbCritical,DEFAULT_TITLE & " - Abbruch!"
End if
'------------------------------------------------------------------------------------------------------------------------------------------------------------------
ElseIf (BUTTON = LEVEL3_BTN_Restore_Configs_ID) Then
Set SQLResult_Configs = Conn.Select(SQLQuery_Configs_Default)
If (SQLResult_Configs.RowCount) > 0 Then
MsgBoxResult = MsgBox ("Wenn Sie fortfahren, werden die Auslieferungskonfigurationen gelöscht und neu angelegt!" & vbCrLf & vbCrLf & _
"Änderungen an diesen gehen verloren!" & vbCrLf & vbCrLf & _
"Der Vorgang kann NICHT Rückgängig gemacht werden!" & vbCrLf & vbCrLf & _
"Möchten Sie fortfahren?",vbYesNo+vbCritical,DEFAULT_TITLE & " - ACHTUNG! ACHTUNG!")
If (MsgBoxResult = 6) Then
SQLResult_Configs = Conn.ExecuteSQL(SQLDelete_Configs)
LEVEL2_GRID_CURRENT_ROW = 0
LEVEL2_GRID_CURRENT_GUID = 0
LEVEL2_GRID_CURRENT_AKTIV = 0
LEVEL2_GRID_CURRENT_Beschreibung = 0
LEVEL2_GRID_CURRENT_Mandant = 0
If (SQLResult_Configs = true) Then
'After the delete insert
InsertExportWinLineDoc_SQLData LEVEL,TemplateExportWinLineDoc_Configs_File
Else
MsgBox "Der Löschvorgang ist fehlgeschlagen!" & vbCrLf & _
"Bitte informieren Sie Ihren Administrator!" & vbCrLf & _
"",vbOkayOnly+vbCritical,DEFAULT_TITLE & " - Fehler!"
SQLResult_Configs = 0
End if
Else
MsgBox "Der Vorgang wurde abgebrochen!",vbOkayOnly+vbInformation,DEFAULT_TITLE
End if
Else
InsertExportWinLineDoc_SQLData LEVEL,TemplateExportWinLineDoc_Configs_File
End If
Else
MsgBox "Die Vorlagen-Datei wurde nicht gefunden!" & vbCrLf & vbCrLf &_
TemplateExportWinLineDoc_Configs_File & vbCrLf & _
"",vbYesNo+vbCritical,DEFAULT_TITLE & " - Abbruch!"
End if
End Sub
'------------------------------------------------------------------------------------------------------------------
Private Sub InsertExportWinLineDoc_SQLData(LEVEL,FILE)
'Get file content of the sql script
FileToRead.CharSet = "utf-8"
FileToRead.Open
FileToRead.LoadFromFile(File)
FileToReadContents = FileToRead.ReadText()
FileToRead.Close
SQLInsert = FileToReadContents
'Replace the default TB names
SQLInsert = Replace(SQLInsert,"[dbo].[t650]",TBDD_EXPORT_WINLINEDOC_CONFIG)
SQLInsert = Replace(SQLInsert,"[dbo].[t651]",TBDD_EXPORT_WINLINEDOC_PROFILE)
'Some magic OTRS cannot do
SQLInsert = Replace(SQLInsert,vbCr,"")
SQLInsert = Replace(SQLInsert,vbLf,"")
SQLInsert = TRIM(SQLInsert)
'Execute Insert - remember that no "GO" order is supported
SQLResult = Conn.ExecuteSQL(SQLInsert)
IF (SQLResult = True) Then
msgbox "Die Wiederherstellung war erfolgreich!",vbOkayOnly+vbInformation,DEFAULT_TITLE
ElseIf (SQLResult = False) Then
msgbox "Achtung, es ist ein Fehler aufgetreten!" & vbCrLf & _
"Bitte informieren Sie Ihren Administrator!" & vbCrLf & _
"",vbOkayOnly+vbCritical,DEFAULT_TITLE
End if
IF (LEVEL = 1) Then
SetExportWinLineDoc_TableContent LEVEL,LEVEL1_GRID_ID
ElseIf (LEVEL = 2) Then
SetExportWinLineDoc_TableContent LEVEL,LEVEL2_GRID_ID
End if
End Sub

View File

@ -0,0 +1,107 @@
' SetExportWinLineDoc_TableContent
' ----------------------------------------------------------------------------
' Diese Subroutine füllt eine Tabelle (Grid) mit Daten
' Parameter 1 (LEVEL) = Das aktuelle Showlevel übergeben.
' Parameter 2 (GRID) = Falls mehrere Grids auf einem Level vorkommen, kann über diesen Parameter nochmals unterscheiden werden.
'
' ----------------------------------------------------------------------------
' 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: 07.07.2021 / MK
' Version Date / Editor: 07.07.2021 / MK
' Version Number: 1.0.0.0
Sub SetExportWinLineDoc_TableContent(LEVEL,GRID)
If (LEVEL = 1) or (LEVEL = "1") Then
If (GRID = LEVEL1_GRID_ID) Then
LEVEL1_Grid.Clear
LEVEL1_Grid.InitUserGrid
LEVEL1_Grid.Header
Set SQLResult_Profiles = Conn.Select(SQLQuery_Profiles)
If (SQLResult_Profiles.RowCount) > 0 Then
LEVEL1_Grid.IsRedraw = False
'Fill left Frame / Table
If (SQLResult_Profiles.RowCount > 0) Then
Do
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = cint(SQLResult_Profiles.value("u000"))
CWLCurrentWindow.ActiveWindow.Vars.Value(495,1) = cstr(SQLResult_Profiles.value("u001"))
CWLCurrentWindow.ActiveWindow.Vars.Value(495,2) = cstr(SQLResult_Profiles.value("u002"))
CWLCurrentWindow.ActiveWindow.Vars.Value(495,3) = cstr(SQLResult_Profiles.value("u003"))
LEVEL1_Grid.AddLine()
'Trick it, because rowcount wont work
If (SQLResult_Profiles.NextRecord = False) Then
Exit Do
End If
Loop
End If
LEVEL1_Grid.IsRedraw = True
'Show count down below the table
LEVEL1_TXT_TabelCounter.Contents = (Cstr(LEVEL1_Grid.LineCount) & " Zuordnungen gefunden")
'Set focus for the fist call, so ribbon buttons will work well (eg. NEW)
MacroCommands.MSetFieldFocus MAIN_WINDOW_ID,LEVEL1_GRID_ID
End If
End If
'------------------------------------------------------------------------------------------------------------------------------------------------------------------
ElseIf (LEVEL = 2) or (LEVEL = "2") Then
If (GRID = LEVEL2_GRID_ID) Then
LEVEL2_Grid.Clear
LEVEL2_Grid.InitUserGrid
LEVEL2_Grid.Header
Set SQLResult_Configs = Conn.Select(SQLQuery_Configs)
If (SQLResult_Configs.RowCount) > 0 Then
LEVEL2_Grid.IsRedraw = False
'Fill left Frame / Table
If (SQLResult_Configs.RowCount > 0) Then
Do
CWLCurrentWindow.ActiveWindow.Vars.Value(495,50) = cint(SQLResult_Configs.value("u000"))
CWLCurrentWindow.ActiveWindow.Vars.Value(495,51) = cstr(SQLResult_Configs.value("u001"))
CWLCurrentWindow.ActiveWindow.Vars.Value(495,52) = cstr(SQLResult_Configs.value("u002"))
CWLCurrentWindow.ActiveWindow.Vars.Value(495,53) = cstr(SQLResult_Configs.value("u003"))
LEVEL2_Grid.AddLine()
'Trick it, because rowcount wont work
If (SQLResult_Configs.NextRecord = False) Then
Exit Do
End If
Loop
End If
LEVEL2_Grid.IsRedraw = True
'Show count down the table
LEVEL2_TXT_TabelCounter.Contents = (Cstr(LEVEL2_Grid.LineCount) & " Zuordnungen gefunden")
'Set focus for the fist call, so ribbon buttons will work well (eg. NEW)
MacroCommands.MSetFieldFocus MAIN_WINDOW_ID,LEVEL2_GRID_ID
End If
End If
End if
End Sub

View File

@ -0,0 +1,45 @@
' SetExportWinLineDoc_TableLayout
' ----------------------------------------------------------------------------
' Diese Subroutine bereitet das Layout / die Spalten einer Tabelle (Grid) vor.
' Parameter 1 (LEVEL) = Das aktuelle Showlevel übergeben.
' Parameter 2 (GRID) = Falls mehrere Grids auf einem Level vorkommen, kann über diesen Parameter nochmals unterscheiden werden.
'
' ----------------------------------------------------------------------------
' 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.07.2021 / MK
' Version Date / Editor: 05.07.2021 / MK
' Version Number: 1.0.0.0
Sub SetExportWinLineDoc_TableLayout(LEVEL,GRID)
If (LEVEL = 1) or (LEVEL = "1") Then
If (GRID = LEVEL1_GRID_ID) Then
LEVEL1_GRID_COLUMN_GUID = LEVEL1_Grid.AddColumn("GUID", "T21,GUID", "1","V",0,495,0, 0,scrtflag+sizeflag+hideflag)
LEVEL1_GRID_COLUMN_AKTIV = LEVEL1_Grid.AddColumn("Aktiv", "T17,Aktiv", "l","V",0,495,1, 5,scrtflag+sizeflag+hideflag)
LEVEL1_GRID_COLUMN_BESCHREIBUNG = LEVEL1_Grid.AddColumn("Beschreibung", "T21,Beschreibung", "1","V",0,495,2,40,scrtflag+sizeflag+hideflag)
LEVEL1_GRID_COLUMN_MANDANT = LEVEL1_Grid.AddColumn("Mandant", "T21,Mandant", "1","V",0,495,3, 8,scrtflag+sizeflag+hideflag)
End If
'------------------------------------------------------------------------------------------------------------------------------------------------------------------
ElseIf (LEVEL = 2) or (LEVEL = "2") Then
If (GRID = LEVEL2_GRID_ID) Then
LEVEL2_GRID_COLUMN_GUID = LEVEL2_Grid.AddColumn("GUID", "T21,GUID", "1","V",0,495,50, 0,scrtflag+sizeflag+hideflag)
LEVEL2_GRID_COLUMN_AKTIV = LEVEL2_Grid.AddColumn("Aktiv", "T17,Aktiv", "l","V",0,495,51, 5,scrtflag+sizeflag+hideflag)
LEVEL2_GRID_COLUMN_BESCHREIBUNG = LEVEL2_Grid.AddColumn("Beschreibung", "T21,Beschreibung", "1","V",0,495,52,40,scrtflag+sizeflag+hideflag)
LEVEL2_GRID_COLUMN_MANDANT = LEVEL2_Grid.AddColumn("Mandant", "T21,Mandant", "1","V",0,495,53, 8,scrtflag+sizeflag+hideflag)
End If
End if
End Sub

View File

@ -0,0 +1,53 @@
' ShowExportWinLineDoc_Level
' ----------------------------------------------------------------------------
' Diese Subroutine aktiviert unterschiedliche Showlevel.
' Parameter 1 (LEVEL) = Das zu setzende Showlevel übergeben.
'
' ----------------------------------------------------------------------------
' 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: 15.07.2021 / MK
' Version Date / Editor: 15.07.2021 / MK
' Version Number: 1.0.0.0
Sub ShowExportWinLineDoc_Level(LEVEL)
If (LEVEL = 1) or (LEVEL = "1") Then
CWLCurrentWindow.ActiveWindow.SetShowLevel 1,1,True
CWLCurrentWindow.ActiveWindow.SetShowLevel 2,2,False
CWLCurrentWindow.ActiveWindow.SetShowLevel 3,3,False
CURRENT_LEVEL = 1
'Set focus, so ribbon buttons will work well (eg. NEW)
MacroCommands.MSetFieldFocus MAIN_WINDOW_ID,LEVEL1_GRID_ID
ElseIf (LEVEL = 2) or (LEVEL = "2") Then
CWLCurrentWindow.ActiveWindow.SetShowLevel 2,2,True
CWLCurrentWindow.ActiveWindow.SetShowLevel 1,1,False
CWLCurrentWindow.ActiveWindow.SetShowLevel 3,3,False
CURRENT_LEVEL = 2
'Set focus, so ribbon buttons will work well (eg. NEW)
MacroCommands.MSetFieldFocus MAIN_WINDOW_ID,LEVEL2_GRID_ID
ElseIf (LEVEL = 3) or (LEVEL = "3") Then
CWLCurrentWindow.ActiveWindow.SetShowLevel 3,3,True
CWLCurrentWindow.ActiveWindow.SetShowLevel 0,0,False
CWLCurrentWindow.ActiveWindow.SetShowLevel 1,1,False
CWLCurrentWindow.ActiveWindow.SetShowLevel 2,2,False
CURRENT_LEVEL = 3
'MacroCommands.MSetFieldFocus MAIN_WINDOW_ID,LEVEL3_TXT_Blank_ID
End if
End Sub

View File

@ -0,0 +1,230 @@
' SwitchExportWinLineDoc_TableContent
' ----------------------------------------------------------------------------
' Diese Subroutine läd Daten beim Zeilenwechel im Grid und zeigt diese ggf. an.
' Parameter 1 (LEVEL) = Das aktuelle Showlevel übergeben.
' Parameter 2 (GRID) = Falls mehrere Grids auf einem Level vorkommen, kann über diesen Parameter nochmals unterscheiden werden.
' Parameter 3 (UPDATE) = Falls vor dem Wechsel eine Prüfung auf geänderte Daten durchgeführt werden soll.
'
' ----------------------------------------------------------------------------
' 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: 15.07.2021 / MK
' Version Date / Editor: 15.07.2021 / MK
' Version Number: 1.0.0.0
Sub SwitchExportWinLineDoc_TableContent(LEVEL,GRID,UPDATE)
'Set global var to prevent focus change -> "rumflackern"
PREVENT_FOCUS_CHANGE = True
If (LEVEL = 1) or (LEVEL = "1") Then
If (GRID = LEVEL1_GRID_ID) Then
'Check if there are unsaved changes before switch line
If (LEVEL1_GRID_CURRENT_ROW > 0) and ((LEVEL1_GRID_CURRENT_GUID > 0) and (LEVEL1_GRID_CURRENT_GUID <> -1)) and (UPDATE = true) Then
SaveExportWinLineDoc_Record CURRENT_LEVEL,LEVEL1_GRID_CURRENT_GUID,False
End If
LEVEL1_GRID.GetCurrentCell CURRENT_ROW, CURRENT_COLUMN
GRIDSelectedLines = LEVEL1_GRID.SelectedLines
If isarray (GRIDSelectedLines) Then
If Ubound(GRIDSelectedLines) = 0 Then
LEVEL1_GRID_CURRENT_ROW = GRIDSelectedLines(0)
LEVEL1_GRID_CURRENT_GUID = LEVEL1_GRID.GetCellValue(CURRENT_ROW,LEVEL1_GRID_COLUMN_GUID)
LEVEL1_GRID_CURRENT_AKTIV = LEVEL1_GRID.GetCellValue(CURRENT_ROW,LEVEL1_GRID_COLUMN_AKTIV)
LEVEL1_GRID_CURRENT_Beschreibung = LEVEL1_GRID.GetCellValue(CURRENT_ROW,LEVEL1_GRID_COLUMN_BESCHREIBUNG)
LEVEL1_GRID_CURRENT_Mandant = LEVEL1_GRID.GetCellValue(CURRENT_ROW,LEVEL1_GRID_COLUMN_MANDANT)
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
msgbox "CURRENT_ROW: " & LEVEL1_GRID_CURRENT_ROW & vbCrlf & _
"CURRENT_GUID: " & LEVEL1_GRID_CURRENT_GUID & vbCrlf & _
"CURRENT_AKTIV: " & LEVEL1_GRID_CURRENT_AKTIV & vbCrlf & _
"CURRENT_Beschreibung: " & LEVEL1_GRID_CURRENT_Beschreibung & vbCrlf & _
"CURRENT_Mandant: " & LEVEL1_GRID_CURRENT_Mandant & vbCrlf & _
"",vbOkayonly+vbInformation, DEBUG_TITLE & "SwitchExportWinLineDoc_TableContent"
End If
If (LEVEL1_GRID_CURRENT_GUID > 0) Then
'For the first call the value allocation (.contents) must run through all fields
'Otherwise every "Must-Field" must be clicked manually!
'This is corresponding with the "bResult.Value" in the OnCheckUserfield Event
LEVEL1_GRID_CALLCOUNT = LEVEL1_GRID_CALLCOUNT + 1
'Set static fields to activ
EnableExportWinLineDoc_InputControls CURRENT_LEVEL,"static"
'get data for selected line
GetExportWinLineDoc_Record CURRENT_LEVEL,LEVEL1_GRID_ID,CURRENT_GUID
'set data to the read only fields
SetExportWinLineDoc_ReadOnlyControls CURRENT_LEVEL
'set data to the writable fields
SetExportWinLineDoc_InputControls CURRENT_LEVEL,"static"
'Enable / Disable correponding Toolbar Buttons
DisableExportWinLineDoc_ButtonControls CURRENT_LEVEL,"dynamic"
EnableExportWinLineDoc_ButtonControls CURRENT_LEVEL,"dynamic"
End If
'For the first call set focus once to the "Must-Fields"
IF ((LEVEL1_GRID_CURRENT_ROW > 0) and (LEVEL1_GRID_CURRENT_GUID > 0) and (LEVEL1_GRID_CALLCOUNT < 2)) Then
SetExportWinLineDoc_FocusToRequiredFields CURRENT_LEVEL
End if
Else
'Important in this case, to set these vars to 0 at first
LEVEL1_GRID_CURRENT_ROW = 0
LEVEL1_GRID_CURRENT_GUID = 0
LEVEL1_GRID_CURRENT_AKTIV = 0
LEVEL1_GRID_CURRENT_Beschreibung = 0
LEVEL1_GRID_CURRENT_Mandant = 0
'If no valid line was selected, clear and disable input area
EnableExportWinLineDoc_InputControls CURRENT_LEVEL,"static"
SetExportWinLineDoc_InputControls CURRENT_LEVEL,"clear"
DisableExportWinLineDoc_InputControls CURRENT_LEVEL,"static"
SetExportWinLineDoc_ReadOnlyControls CURRENT_LEVEL
'Disable correponding Toolbar Buttons
DisableExportWinLineDoc_ButtonControls CURRENT_LEVEL,"dynamic"
EnableExportWinLineDoc_ButtonControls CURRENT_LEVEL,"dynamic"
End If
End If
End If
'--------------------------------------------------------------------------------------------------------------------------------------------
ElseIf (LEVEL = 2) or (LEVEL = "2") Then
If (GRID = LEVEL2_GRID_ID) Then
'Check if there are unsaved changes before switch line
If (LEVEL2_GRID_CURRENT_ROW > 0) and ((LEVEL2_GRID_CURRENT_GUID > 0) and (LEVEL2_GRID_CURRENT_GUID <> -1)) and (UPDATE = true) Then
SaveExportWinLineDoc_Record CURRENT_LEVEL,LEVEL2_GRID_CURRENT_GUID,False
End If
LEVEL2_GRID.GetCurrentCell CURRENT_ROW, CURRENT_COLUMN
GRIDSelectedLines = LEVEL2_GRID.SelectedLines
If isarray (GRIDSelectedLines) Then
If Ubound(GRIDSelectedLines) = 0 Then
LEVEL2_GRID_CURRENT_ROW = GRIDSelectedLines(0)
LEVEL2_GRID_CURRENT_GUID = LEVEL2_GRID.GetCellValue(CURRENT_ROW,LEVEL2_GRID_COLUMN_GUID)
LEVEL2_GRID_CURRENT_AKTIV = LEVEL2_GRID.GetCellValue(CURRENT_ROW,LEVEL2_GRID_COLUMN_AKTIV)
LEVEL2_GRID_CURRENT_Beschreibung = LEVEL2_GRID.GetCellValue(CURRENT_ROW,LEVEL2_GRID_COLUMN_BESCHREIBUNG)
LEVEL2_GRID_CURRENT_Mandant = LEVEL2_GRID.GetCellValue(CURRENT_ROW,LEVEL2_GRID_COLUMN_MANDANT)
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
msgbox "CURRENT_ROW: " & LEVEL2_GRID_CURRENT_ROW & vbCrlf & _
"CURRENT_GUID: " & LEVEL2_GRID_CURRENT_GUID & vbCrlf & _
"CURRENT_AKTIV: " & LEVEL2_GRID_CURRENT_AKTIV & vbCrlf & _
"CURRENT_Beschreibung: " & LEVEL2_GRID_CURRENT_Beschreibung & vbCrlf & _
"CURRENT_Mandant: " & LEVEL2_GRID_CURRENT_Mandant & vbCrlf & _
"",vbOkayonly+vbInformation, DEBUG_TITLE & "SwitchExportWinLineDoc_TableContent"
End If
If (LEVEL2_GRID_CURRENT_GUID > 0) Then
'For the first call the value allocation (.contents) must run through all fields
'Otherwise every "Must-Field" must be clicked manually!
'This is corresponding with the "bResult.Value" in the OnCheckUserfield Event
LEVEL2_GRID_CALLCOUNT = LEVEL2_GRID_CALLCOUNT + 1
'Set static fields to activ
EnableExportWinLineDoc_InputControls CURRENT_LEVEL,"static"
'get data for selected line
GetExportWinLineDoc_Record CURRENT_LEVEL,LEVEL2_GRID_ID,CURRENT_GUID
'set data to the read only fields
SetExportWinLineDoc_ReadOnlyControls CURRENT_LEVEL
'set data to the writable fields
SetExportWinLineDoc_InputControls CURRENT_LEVEL,"dynamic"
'Enable / Disable correponding Toolbar Buttons
DisableExportWinLineDoc_ButtonControls CURRENT_LEVEL,"dynamic"
EnableExportWinLineDoc_ButtonControls CURRENT_LEVEL,"dynamic"
'SPECIAL: set data type fileds depending on selcted type on/off
DisableExportWinLineDoc_InputControls CURRENT_LEVEL,"dynamic"
'Check for duplicate on changing data, or new data, or changing someting else and pressing the save button
SQLQuery_ConfigCount = SQLQuery_ConfigCount_Template
SQLQuery_ConfigCount = Replace(SQLQuery_ConfigCount,"%LEVEL2_TXT_Platzhalter_Value%",LEVEL2_TXT_Platzhalter_DBValue)
Set SQLResult_ConfigCount = Conn.Select(SQLQuery_ConfigCount)
IF ((SQLResult_ConfigCount.Rowcount > 1) and (LEVEL2_GRID_CALLCOUNT > 2)) Then
Msgbox "Achtung: Der Platzerhalter " & LEVEL2_TXT_Platzhalter_DBValue & ", " & vbCrlf & _
"wird bereits (" & SQLResult_ConfigCount.Rowcount & "x) verwendet!" & vbCrlf & vbCrlf & _
"Bitte ändern Sie Ihre Eingabe, " & vbCrlf & _
"ansonsten wird es zu Fehlern bei der Dateiablage kommen!" & vbCrlf & vbCrlf & _
"Muster: %PLATZHALTER%" & vbCrlf & _
"",vbInformation+vbOKOnly,DEFAULT_TITLE & " - Zeilenwechsel"
MacroCommands.MSetFieldFocus MAIN_WINDOW_ID,LEVEL2_TXT_Platzhalter_ID
End if
End If
'For the first call set focus once to the "Must-Fields"
IF ((LEVEL2_GRID_CURRENT_ROW > 0) and (LEVEL2_GRID_CURRENT_GUID > 0) and (LEVEL2_GRID_CALLCOUNT < 2)) Then
SetExportWinLineDoc_FocusToRequiredFields CURRENT_LEVEL
End if
Else
'Important in this case, to set these vars to 0 at first
LEVEL2_GRID_CURRENT_ROW = 0
LEVEL2_GRID_CURRENT_GUID = 0
LEVEL2_GRID_CURRENT_AKTIV = 0
LEVEL2_GRID_CURRENT_Beschreibung = 0
LEVEL2_GRID_CURRENT_Mandant = 0
'If no valid line was selected, clear and disable input area
EnableExportWinLineDoc_InputControls CURRENT_LEVEL,"static"
SetExportWinLineDoc_InputControls CURRENT_LEVEL,"clear"
DisableExportWinLineDoc_InputControls CURRENT_LEVEL,"static"
SetExportWinLineDoc_ReadOnlyControls CURRENT_LEVEL
'Disable correponding Toolbar Buttons
DisableExportWinLineDoc_ButtonControls CURRENT_LEVEL,"dynamic"
EnableExportWinLineDoc_ButtonControls CURRENT_LEVEL,"dynamic"
End If
End If
End If
End if
PREVENT_FOCUS_CHANGE = False
End Sub

View File

@ -0,0 +1,23 @@
/******
-- Export-WinLineDoc (EWLD)
-- =================================================================
-- Dieses Skript legt vordefinierte Konfigurationen an.
-- =================================================================
-- 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: 15.07.2021 / MK
-- Version Date / Editor: 15.07.2021 / MK
-- Version Number: 1.0.0.0
-- =================================================================
-- History:
-- 15.07.2021 / MK - Erstellung
--
-- HINWEISE: Keine Go Befehle verwenden!
******/
INSERT [dbo].[t650] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [U010], [U011], [U012], [U013], [U014]) VALUES (1, N'1', N'Mandant Kurzname', N'ALL', N'CUSTOM_VARIABLE', N'%KURZNAME_MANDANT%', N'TEXT', N'Toys&Bikes', 0, 0, CAST(N'1970-01-01T00:00:00.000' AS DateTime), N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
INSERT [dbo].[t650] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [U010], [U011], [U012], [U013], [U014]) VALUES (2, N'1', N'Exportpfad', N'ALL', N'CUSTOM_VARIABLE', N'%EXPORTPATH%', N'TEXT', N'c:\WinLine\Dokumentablage', 0, 0, CAST(N'1970-01-01T00:00:00.000' AS DateTime), N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)

View File

@ -0,0 +1,112 @@
/******
-- Export-WinLineDoc (EWLD)
-- =================================================================
-- Dieses Skript legt vordefinierte Profile an.
-- =================================================================
-- 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: 15.07.2021 / MK
-- Version Date / Editor: 15.07.2021 / MK
-- Version Number: 1.0.0.0
-- =================================================================
-- History:
-- 15.07.2021 / MK - Erstellung
--
-- HINWEISE: Keine Go Befehle verwenden!
******/
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (1, 1, N'Angebot (debitorisch)', N'ALL', N'1', N'1', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Kunden-Angebot\%YEAR%\%MONTH%', N'%MandantenNr%-AANG-%AngebotsNr%-%KontoName%
', N'%MandantenNr%-AANG-%AngebotsNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (2, 1, N'Angebot-Storno (debitorisch)', N'ALL', N'1', N'11', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Kunden-Angebot-Storno\%YEAR%\%MONTH%', N'%MandantenNr%-AANG-Storno-%AngebotsNr%-%KontoName%
', N'%MandantenNr%-AANG-Storno-%AngebotsNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (3, 1, N'Auftrag (debitorisch)', N'ALL', N'1', N'2', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Kunden-Auftrag\%YEAR%\%MONTH%
', N'%MandantenNr%-AAB-%AuftragsNr%-%KontoName%
', N'%MandantenNr%-AAB-%AuftragsNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (4, 1, N'Auftrag-Storno (debitorisch)', N'ALL', N'1', N'12', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Kunden-Auftrag-Storno\%YEAR%\%MONTH%
', N'%MandantenNr%-AAB-Storno-%AuftragsNr%-%KontoName%
', N'%MandantenNr%-AAB-Storno-%AuftragsNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (5, 1, N'Lieferschein (debitorisch)', N'ALL', N'1', N'3', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Kunden-Lieferschein\%YEAR%\%MONTH%
', N'%MandantenNr%-ALS-%LieferscheinNr%-%KontoName%
', N'%MandantenNr%-ALS-%LieferscheinNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (6, 1, N'Lieferschein-Storno (debitorisch)', N'ALL', N'1', N'13', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Kunden-Lieferschein-Storno\%YEAR%\%MONTH%
', N'%MandantenNr%-ALS-Storno-%LieferscheinNr%-%KontoName%
', N'%MandantenNr%-ALS-Storno-%LieferscheinNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (7, 1, N'Rechnung (debitorisch)', N'ALL', N'1', N'4', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Kunden-Rechnung\%YEAR%\%MONTH%
', N'%MandantenNr%-ARE-%RechnungsNr%-%KontoName%
', N'%MandantenNr%-ARE-%RechnungsNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (8, 1, N'Rechnung-Storno (debitorisch)', N'ALL', N'1', N'14', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Kunden-Rechnung-Storno\%YEAR%\%MONTH%
', N'%MandantenNr%-ARE-Storno-%RechnungsNr%-%KontoName%
', N'%MandantenNr%-ARE-Storno-%RechnungsNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (9, 1, N'Anfrage (kreditorisch)', N'ALL', N'2', N'1', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Lieferanten-Anfrage\%YEAR%\%MONTH%
', N'%MandantenNr%-AANF-%AnfragenNr%-%KontoName%
', N'%MandantenNr%-AANF-%AnfragenNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (10, 1, N'Anfrage-Storno (kreditorisch)', N'ALL', N'2', N'11', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Lieferanten-Anfrage-Storno\%YEAR%\%MONTH%
', N'%MandantenNr%-AANF-Storno-%AnfragenNr%-%KontoName%
', N'%MandantenNr%-AANF-Storno-%AnfragenNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (11, 1, N'Bestellung (kreditorisch)', N'ALL', N'2', N'2', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Lieferanten-Bestellung\%YEAR%\%MONTH%
', N'%MandantenNr%-ABE-%BestellNr%-%KontoName%
', N'%MandantenNr%-ABE-%BestellNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (12, 1, N'Bestellung-Storno (kreditorisch)', N'ALL', N'2', N'12', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Lieferanten-Bestellung-Storno\%YEAR%\%MONTH%
', N'%MandantenNr%-ABE-Storno-%BestellNr%-%KontoName%
', N'%MandantenNr%-ABE-Storno-%BestellNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (13, 1, N'Lieferschein (kreditorisch)', N'ALL', N'2', N'3', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Lieferanten-Lieferschein\%YEAR%\%MONTH%
', N'%MandantenNr%-ELS-%LieferscheinNr%-%KontoName%
', N'%MandantenNr%-ELS-%LieferscheinNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (14, 1, N'Lieferschein-Storno (kreditorisch)', N'ALL', N'2', N'13', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Lieferanten-Lieferschein-Storno\%YEAR%\%MONTH%
', N'%MandantenNr%-ELS-Storno-%LieferscheinNr%-%KontoName%
', N'%MandantenNr%-ELS-Storno-%LieferscheinNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (15, 1, N'Rechnung (kreditorisch)', N'ALL', N'2', N'4', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Lieferanten-Rechnung\%YEAR%\%MONTH%
', N'%MandantenNr%-ERE-%RechnungsNr%-%KontoName%
', N'%MandantenNr%-ERE-%RechnungsNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (16, 1, N'Rechnung-Storno (kreditorisch)', N'ALL', N'2', N'14', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Lieferanten-Rechnung-Storno\%YEAR%\%MONTH%
', N'%MandantenNr%-ERE-Storno-%RechnungsNr%-%KontoName%
', N'%MandantenNr%-ERE-Storno-%RechnungsNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (17, 1, N'Teillieferschein (debitorisch)', N'ALL', N'1', N'-3', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Kunden-Teillieferschein\%YEAR%\%MONTH%
', N'%MandantenNr%-ATLS-%LieferscheinNr%-%KontoName%
', N'%MandantenNr%-ATLS-%LieferscheinNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (18, 1, N'Gutschrift (debitorisch)', N'ALL', N'1', N'4', NULL, N'NegativAmount', NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Kunden-Gutschrift\%YEAR%\%MONTH%
', N'%MandantenNr%-AGU-%RechnungsNr%-%KontoName%
', N'%MandantenNr%-AGU-%RechnungsNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (19, 1, N'Rechnungskorrektur (debitorisch)', N'ALL', N'1', N'4', NULL, N'NegativAmount', N'Correction', NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Kunden-Rechnungskorrektur\%YEAR%\%MONTH%
', N'%MandantenNr%-AREK-%RechnungsNr%-%KontoName%
', N'%MandantenNr%-AREK-%RechnungsNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)

View File

@ -0,0 +1,595 @@
' Export-WinLineDoc (EWLD)
' VB-Script for exporting printed docs to Filesystem.
' ----------------------------------------------------------------
' 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.07.2021 / MK
' Version Date / Editor: 09.10.2021 / MK
' Version Number: 3.1.0.0
On Error Resume Next
'#set variables#
DocVersionSeparator = "~"
ReplaceSpecialChar = ""
DebugMode = "Disabled" 'Enabled
PROFILE_TB = "[T651]"
CONFIG_TB = "[T650]"
CONFIG_GUID = 0
WebServiceUser = "meso"
WebServiceUser_MandantenstammID = 211
'#set constants#
DEFAULT_TITLE ="Export-WinLineDoc"
DEBUG_TITLE ="DEBUG - " & DEFAULT_TITLE
EWLD_GUID =0
DocVersion =1
WinLineCurrentUser =CWLStart.CurrentUser.Name
MandatorNr =TRIM(CSTR(Value (0,11)))
ProgramDocType =TRIM(CSTR(Value (0,20)))
RunningNr =TRIM(CSTR(Value (0,31)))
OfferNr =TRIM(CSTR(Value (0,34)))
OrderNr =TRIM(CSTR(Value (0,35)))
DeliveryNoteNr =TRIM(CSTR(Value (0,36)))
InvoiceNr =TRIM(CSTR(Value (0,37)))
InquireNr =TRIM(CSTR(Value (0,34)))
PurchaseNr =TRIM(CSTR(Value (0,35)))
DocNr =TRIM(CSTR(Value (0,39)))
DocCreationDate =TRIM(CSTR(Value (0,54)))
DocChangedDate =TRIM(CSTR(Value (0,55)))
DocType =TRIM(CSTR(Value (0,113)))
Text1 =TRIM(CSTR(Value (25,63)))
Text2 =TRIM(CSTR(Value (25,64)))
Text3 =TRIM(CSTR(Value (25,65)))
Text4 =TRIM(CSTR(Value (25,66)))
Text5 =TRIM(CSTR(Value (25,67)))
Text6 =TRIM(CSTR(Value (25,68)))
Text7 =TRIM(CSTR(Value (25,69)))
Text8 =TRIM(CSTR(Value (25,70)))
Text9 =TRIM(CSTR(Value (25,71)))
Text10 =TRIM(CSTR(Value (25,72)))
DocFinalAmount =TRIM(CSTR(Value (25,100)))
ProjectNr =TRIM(CSTR(Value (25,136)))
InvoiceForCorrection =TRIM(CSTR(Value (25,147)))
DocComment =TRIM(CSTR(Value (25,165)))
AccountNr =TRIM(CSTR(Value (50,2)))
AccountName =TRIM(CSTR(Value (50,3)))
AddText1 =TRIM(CSTR(Value (50,201)))
AddText2 =TRIM(CSTR(Value (50,202)))
AddText3 =TRIM(CSTR(Value (50,203)))
AddText4 =TRIM(CSTR(Value (50,204)))
AddText5 =TRIM(CSTR(Value (50,205)))
AddText6 =TRIM(CSTR(Value (50,206)))
AddText7 =TRIM(CSTR(Value (50,207)))
AddText8 =TRIM(CSTR(Value (50,208)))
AddText9 =TRIM(CSTR(Value (50,209)))
AddText10 =TRIM(CSTR(Value (50,210)))
AddText11 =TRIM(CSTR(Value (50,211)))
AddText12 =TRIM(CSTR(Value (50,212)))
AddText13 =TRIM(CSTR(Value (50,213)))
AddText14 =TRIM(CSTR(Value (50,214)))
AddText15 =TRIM(CSTR(Value (50,215)))
AddText16 =TRIM(CSTR(Value (50,216)))
AddText17 =TRIM(CSTR(Value (50,217)))
AddText18 =TRIM(CSTR(Value (50,218)))
AddText19 =TRIM(CSTR(Value (50,219)))
AddText20 =TRIM(CSTR(Value (50,220)))
AddText21 =TRIM(CSTR(Value (50,221)))
AddText22 =TRIM(CSTR(Value (50,222)))
AddText23 =TRIM(CSTR(Value (50,223)))
AddText24 =TRIM(CSTR(Value (50,224)))
AddText25 =TRIM(CSTR(Value (50,225)))
AddText26 =TRIM(CSTR(Value (50,226)))
AddText27 =TRIM(CSTR(Value (50,227)))
AddText28 =TRIM(CSTR(Value (50,228)))
AddText29 =TRIM(CSTR(Value (50,229)))
AddText30 =TRIM(CSTR(Value (50,230)))
PostingType =TRIM(CSTR(Value (357,6)))
ExportType =OutputType
ExportDone ="ERROR!"
PROFILE_SQL_MAN = "[u000] = '"& CONFIG_GUID &"' AND [u001] = 1"
PROFILE_SQL_AUTO= "[u001] = 1 AND [u003] IN ('ALL','"& MandatorNr &"') AND [u004] = '"& PostingType &"' AND [u005] = '"& ProgramDocType &"' AND ([u006] = '"& DocType &"' OR [u006] IS NULL)"
CONFIG_SQL = "[u001] = 1 AND [u003] IN ('ALL','"& MandatorNr &"') AND [u004] In ('CUSTOM_VARIABLE') AND [u005] IS NOT NULL AND [u006] IS NOT NULL AND ([u007] IS NOT NULL OR [u008] IS NOT NULL OR [u009] IS NOT NULL OR [u010] IS NOT NULL)"
RegExpValidFilename = "[^a-zA-Z0-9\"&chr(64)&"\ü\ö\ä\Ü\Ö\Ä\ß\{\[\]\}\ \!\§\$\%\&\(\)\=\+\#\,\.\-\;\_\']{1,}"
RegExpValidFilepath = "[^a-zA-Z0-9\"&chr(64)&"\ü\ö\ä\Ü\Ö\Ä\ß\{\[\]\}\ \!\§\$\%\&\(\)\=\+\#\,\.\-\;\_\'\\]{1,}"
SET FileSystemObject= CreateObject("Scripting.FileSystemObject")
SET RI = CreateObject("Scripting.Dictionary")
RI.CompareMode = vbTextCompare
SET RegExpObject = New RegExp
RegExpObject.IgnoreCas = true
RegExpObject.Global = true
'#preparing part#
'Reset Error Var
Err.Clear
'No msgbox!
If (WinLineCurrentUser=WebServiceUser) Then
DebugMode="Disabled"
End if
'Use central
If (WebServiceUser="") Then
WebServiceUser=CWLStart.CurrentCompany.Value(WebServiceUser_MandantenstammID)
End if
'Fallback "Ursp. Beleg"
IF (DocNr=Empty) and (InvoiceNr<>Empty) Then
DocNr=InvoiceNr
ELSEIF (DocNr=Empty) and (DeliveryNoteNr<>Empty) Then
DocNr=DeliveryNoteNr
ELSEIF (DocNr=Empty) and (OrderNr<>Empty) Then
DocNr=OrderNr
ELSEIF (DocNr=Empty) and (PurchaseNr<>Empty) Then
DocNr=PurchaseNr
ELSEIF (DocNr=Empty) and (OfferNr<>Empty) Then
DocNr=OfferNr
ELSEIF (DocNr=Empty) and (InquireNr<>Empty) Then
DocNr=InquireNr
End if
'Fallback
If (AccountNr="") Then
AccountNr=TRIM(CSTR(Value (5,2)))
If (AccountNr="") Then
AccountNr=TRIM(CSTR(Value (0,30)))
End if
End if
If (AccountName="") Then
AccountName=TRIM(CSTR(Value (5,3)))
End if
IF (DebugMode="Enabled") THEN
MSGBOX "MandatorNr: " &MandatorNr &vbCrLf&_
"ProgramDocType: "&ProgramDocType &vbCrLf&_
"RunningNr: " &RunningNr &vbCrLf&_
"PostingType: " &PostingType,,DEBUG_TITLE&" - WinLine Runtime Variables"
MSGBOX "Profile SQL:"&vbCrLf& PROFILE_SQL_AUTO&vbCrLf&vbCrLf&_
"Config SQL: "&vbCrLf& CONFIG_SQL,,DEBUG_TITLE&" - SQL Commands (not final!)"
END IF
'RI = Replace Object, because functions are not available
RI.ADD "%MandantenNr%",MandatorNr
RI.ADD "%Laufnummer%",RunningNr
RI.ADD "%UserName%",WinLineCurrentUser
RI.ADD "%KontoNr%",AccountNr
RI.ADD "%KontoName%",AccountName
RI.ADD "%ProjektNr%",ProjectNr
RI.ADD "%AngebotsNr%",OfferNr
RI.ADD "%AuftragsNr%",OrderNr
RI.ADD "%LieferscheinNr%",DeliveryNoteNr
RI.ADD "%RechnungsNr%",InvoiceNr
RI.ADD "%AnfragenNr%",InquireNr
RI.ADD "%BestellNr%",PurchaseNr
RI.ADD "%Belegart%",DocType
RI.ADD "%Belegnummer%",DocNr
RI.ADD "%BelegKommentar%",DocComment
RI.ADD "%Textzeile1%",Text1
RI.ADD "%Textzeile2%",Text2
RI.ADD "%Textzeile3%",Text3
RI.ADD "%Textzeile4%",Text4
RI.ADD "%Textzeile5%",Text5
RI.ADD "%Textzeile6%",Text6
RI.ADD "%Textzeile7%",Text7
RI.ADD "%Textzeile8%",Text8
RI.ADD "%Textzeile9%",Text9
RI.ADD "%Textzeile10%",Text10
RI.ADD "%Zusatzfeld1%",AddText1
RI.ADD "%Zusatzfeld2%",AddText2
RI.ADD "%Zusatzfeld3%",AddText3
RI.ADD "%Zusatzfeld4%",AddText4
RI.ADD "%Zusatzfeld5%",AddText5
RI.ADD "%Zusatzfeld6%",AddText6
RI.ADD "%Zusatzfeld7%",AddText7
RI.ADD "%Zusatzfeld8%",AddText8
RI.ADD "%Zusatzfeld9%",AddText9
RI.ADD "%Zusatzfeld10%",AddText10
RI.ADD "%Zusatzfeld11%",AddText11
RI.ADD "%Zusatzfeld12%",AddText12
RI.ADD "%Zusatzfeld13%",AddText13
RI.ADD "%Zusatzfeld14%",AddText14
RI.ADD "%Zusatzfeld15%",AddText15
RI.ADD "%Zusatzfeld16%",AddText16
RI.ADD "%Zusatzfeld17%",AddText17
RI.ADD "%Zusatzfeld18%",AddText18
RI.ADD "%Zusatzfeld19%",AddText19
RI.ADD "%Zusatzfeld20%",AddText20
RI.ADD "%Zusatzfeld21%",AddText21
RI.ADD "%Zusatzfeld22%",AddText22
RI.ADD "%Zusatzfeld23%",AddText23
RI.ADD "%Zusatzfeld24%",AddText24
RI.ADD "%Zusatzfeld25%",AddText25
RI.ADD "%Zusatzfeld26%",AddText26
RI.ADD "%Zusatzfeld27%",AddText27
RI.ADD "%Zusatzfeld28%",AddText28
RI.ADD "%Zusatzfeld29%",AddText29
RI.ADD "%Zusatzfeld30%",AddText30
RI.ADD "%DAY%",(day(date))
RI.ADD "%DAYNAME%",(WeekdayName(weekday(now())))
RI.ADD "%MONTH%",(month(date))
RI.ADD "%MONTHNAME%",MonthName((month(date)))
RI.ADD "%YEAR%",(Year(date))
'Get doc profile
IF ((Mid(DocFinalAmount,1,1))="-") and (InvoiceForCorrection<>Empty) THEN
PROFILE_SQL_AUTO = PROFILE_SQL_AUTO&" AND [u007] like '%NegativAmount%' AND [u008] like '%Correction%'"
Elseif ((Mid(DocFinalAmount,1,1))="-") THEN
PROFILE_SQL_AUTO = PROFILE_SQL_AUTO&" AND [u007] like '%NegativAmount%'"
END IF
'Override the logic here, by setting the CONFIG_GUID Var with a value higher then 0 (for not FAKT docs).
IF (CONFIG_GUID>0) Then
SET PROFILE_RESULT=CWLStart.CurrentCompany.SearchRecord(PROFILE_TB,PROFILE_SQL_MAN)
Else
SET PROFILE_RESULT=CWLStart.CurrentCompany.SearchRecord(PROFILE_TB,PROFILE_SQL_AUTO)
End IF
IF (Err.Number<>0) THEN
MSGBOX "Error Code: "& Err.Number & vbCrLf & _
"Error Description: "& Err.Description,,"ERROR: Getting Variables from DB Table "&PROFILE
Err.Clear
ELSE
IF (PROFILE_RESULT=-1) Then
IF (DebugMode="Enabled") THEN
MSGBOX "No Rows found, SQL: "&vbCrLf& PROFILE_SQL_AUTO,,DEBUG_TITLE&" Profiles from Database table "&PROFILE
END IF
ELSEIF (PROFILE_RESULT.RowCount>1) Then
IF (WinLineCurrentUser<>WebServiceUser) Then
msgbox "Achtung, das Export-Profil konnte nicht eindeutig identifiziert werden!"&vbCrLf&_
"Das erste passende wird nun verwendet!",,"Bitte den Administrator informieren!"
End if
Else
EWLD_GUID =cint(PROFILE_RESULT.Value(0))
EWLD_DESCRIPTION =Trim(cstr(PROFILE_RESULT.Value(2)))
'14 to 23 -> WILL BE USED LATER!
EWLD_PATH =Trim(cstr(PROFILE_RESULT.Value(24)))
EWLD_FILENAME =Trim(cstr(PROFILE_RESULT.Value(25)))
EWLD_FILENAME_PREVIEW =Trim(cstr(PROFILE_RESULT.Value(26)))
EWLD_FILEEXTENSION =cint(PROFILE_RESULT.Value(27))
EWLD_VERSIONING =cint(PROFILE_RESULT.Value(28))
IF (DebugMode="Enabled") THEN
MSGBOX "GUID: "&EWLD_GUID&vbCrLf&_
"Description: "&EWLD_DESCRIPTION,,DEBUG_TITLE&" document profile from Database table "&PROFILE
END IF
'Get variables from table
SET CONFIG_RESULT=CWLStart.CurrentCompany.SearchRecord(CONFIG_TB,CONFIG_SQL)
IF (Err.Number<>0) THEN
MSGBOX "Error Code: "&Err.Number&vbCrLf&_
"Error Description: "&Err.Description,,"ERROR: Variables from Database table "&CONFIG_SQL&" !"
Err.Clear
ELSE
IF (CONFIG_RESULT=-1) Then
IF (DebugMode="Enabled") THEN
MSGBOX "No Rows found, SQL: "&CONFIG_SQL,,DEBUG_TITLE&" Variables from Database table "&CONFIG_TB
END IF
ELSE
FOR LoopCounter=1 TO CONFIG_RESULT.RowCount
EWLD_CONFIG_NAME=CONFIG_RESULT.Value(5)
EWLD_CONFIG_TYPE=CONFIG_RESULT.Value(6)
EWLD_CONFIG_TEXT=CONFIG_RESULT.Value(7)
EWLD_CONFIG_INT =CONFIG_RESULT.Value(8)
EWLD_CONFIG_DBL =CONFIG_RESULT.Value(9)
EWLD_CONFIG_DATE=CONFIG_RESULT.Value(10)
IF (DebugMode="Enabled") THEN
MSGBOX "Name: " & EWLD_CONFIG_NAME &vbCrLf&_
"Type: " & EWLD_CONFIG_TYPE &vbCrLf&vbCrLf&_
"Text Value: " & EWLD_CONFIG_TEXT &vbCrLf&_
"Integer Value: " & EWLD_CONFIG_INT &vbCrLf&_
"Double Value: " & EWLD_CONFIG_DBL &vbCrLf&_
"Date Value: " & EWLD_CONFIG_DATE,,DEBUG_TITLE&" - "& LoopCounter &" of "& CONFIG_RESULT.RowCount &" Variables from DB table "& CONFIG_TB
END IF
IF TRIM(((EWLD_CONFIG_TYPE))="TEXT") Then
RI.ADD EWLD_CONFIG_NAME,EWLD_CONFIG_TEXT
ElseIf TRIM(((EWLD_CONFIG_TYPE))="INTEGER") Then
RI.ADD EWLD_CONFIG_NAME,EWLD_CONFIG_INT
ElseIf TRIM(((EWLD_CONFIG_TYPE))="DOUBLE") Then
RI.ADD EWLD_CONFIG_NAME,EWLD_CONFIG_DBL
ElseIf TRIM(((EWLD_CONFIG_TYPE))="DATE") Then
RI.ADD EWLD_CONFIG_NAME,EWLD_CONFIG_DATE
End if
CONFIG_RESULT.NextRecord
NEXT
END IF
END IF
'Replace PlaceHolder and ...
IF (EWLD_PATH<>"") THEN
RIKeys = RI.keys
For LoopCounter=0 To RI.Count -1
IF InStr(EWLD_PATH,RIKeys(LoopCounter))>0 Then
EWLD_PATH=Replace(EWLD_PATH,RIKeys(LoopCounter),RI(RIKeys(LoopCounter)))
END IF
Next
'... invalid Characters
EWLD_PATH_TEMP1=Mid(EWLD_PATH,1,2)
EWLD_PATH_TEMP2=Mid(EWLD_PATH,3)
EWLD_PATH_TEMP2=Replace(EWLD_PATH_TEMP2,"\\","\")
RegExpObject.Pattern=RegExpValidFilepath
EWLD_PATH=EWLD_PATH_TEMP1&RegExpObject.Replace(EWLD_PATH_TEMP2,ReplaceSpecialChar)
RI.ADD "%EWLD_PATH%",EWLD_PATH
EWLD_PATH=Replace(EWLD_PATH,vbCr,"")
EWLD_PATH=Replace(EWLD_PATH,vbLf,"")
IF (DebugMode="Enabled") THEN
MSGBOX "EWLD_PATH: "&vbCrLf& EWLD_PATH&vbCrLf&vbCrLf&_
"RI includes "& RI.count &" Items.",,DEBUG_TITLE&" - EWLD_PATH AFTER replace routine"
END IF
END IF
'Replace PlaceHolder and ...
IF (EWLD_FILENAME<>"") THEN
RIKeys=RI.keys
For LoopCounter=0 To RI.Count -1
IF InStr(EWLD_FILENAME,RIKeys(LoopCounter))>0 Then
EWLD_FILENAME=Replace(EWLD_FILENAME,RIKeys(LoopCounter),RI(RIKeys(LoopCounter)))
END IF
Next
'... invalid Characters
EWLD_FILENAME_TEMP=EWLD_FILENAME
RegExpObject.Pattern=RegExpValidFilename
EWLD_FILENAME=RegExpObject.Replace(EWLD_FILENAME_TEMP,ReplaceSpecialChar)
RI.ADD "%EWLD_FILENAME%",EWLD_FILENAME
EWLD_FILENAME=Replace(EWLD_FILENAME,vbCr,"")
EWLD_FILENAME=Replace(EWLD_FILENAME,vbLf,"")
IF (DebugMode="Enabled") THEN
MSGBOX "EWLD_FILENAME: "&vbCrLf& EWLD_FILENAME&vbCrLf&vbCrLf&_
"RI includes "& RI.count &" Items.",,DEBUG_TITLE&" - EWLD_FILENAME AFTER replace routine"
END IF
END IF
'Replace PlaceHolder and ...
IF (EWLD_FILENAME_PREVIEW<>"") THEN
RIKeys=RI.keys
For LoopCounter=0 To RI.Count -1
IF InStr(EWLD_FILENAME_PREVIEW,RIKeys(LoopCounter))>0 Then
EWLD_FILENAME_PREVIEW=Replace(EWLD_FILENAME_PREVIEW,RIKeys(LoopCounter),RI(RIKeys(LoopCounter)))
END IF
Next
'... invalid Characters
EWLD_FILENAME_PREVIEW_TEMP=EWLD_FILENAME_PREVIEW
RegExpObject.Pattern=RegExpValidFilename
EWLD_FILENAME_PREVIEW=RegExpObject.Replace(EWLD_FILENAME_PREVIEW_TEMP,ReplaceSpecialChar)
RI.ADD "%EWLD_FILENAME_PREVIEW%",EWLD_FILENAME_PREVIEW
EWLD_FILENAME_PREVIEW=Replace(EWLD_FILENAME_PREVIEW,vbCr,"")
EWLD_FILENAME_PREVIEW=Replace(EWLD_FILENAME_PREVIEW,vbLf,"")
IF (DebugMode = "Enabled") THEN
MSGBOX "EWLD_FILENAME_PREVIEW: "&vbCrLf& EWLD_FILENAME_PREVIEW &vbCrLf&vbCrLf&_
"RI includes "& RI.count &" Items.",,DEBUG_TITLE&" - EWLD_FILENAME_PREVIEW Variable AFTER replace routine"
END IF
END IF
END IF
END IF
'#main part#
IF ((EWLD_PATH<>"") AND (EWLD_FILENAME<>"") AND (EWLD_FILEEXTENSION<>"") and ((ExportType=2) or (ExportType=4) or (ExportType=5))) THEN
'Check if destination structure exists. If not, try to create.
IF NOT FileSystemObject.FolderExists(EWLD_PATH) THEN
strDir=FileSystemObject.GetAbsolutePathName(EWLD_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
IF (DebugMode = "Enabled") THEN
MSGBOX strDirBuild,,DEBUG_TITLE&" CreateFolder: Level " & idx & " of " & Ubound( arrDirs )
END IF
FileSystemObject.CreateFolder strDirBuild
End if
Next
END IF
'Code block to resolve the file extension, fallback is pdf
IF (EWLD_FILEEXTENSION<7) Then
Select Case EWLD_FILEEXTENSION
Case 0
EWLD_FILEEXTENSION_NAME="spl"
Case 1
EWLD_FILEEXTENSION_NAME="mht"
Case 4
EWLD_FILEEXTENSION_NAME="spl"
Case 5
EWLD_FILEEXTENSION_NAME="pdf"
Case 6
EWLD_FILEEXTENSION_NAME="rtf"
Case ELSE
EWLD_FILEEXTENSION= 5
EWLD_FILEEXTENSION_NAME="pdf"
End Select
Else
EWLD_FILEEXTENSION=5
EWLD_FILEEXTENSION_NAME="pdf"
End if
'If EWLD_PATH exists, export file - including version tagging.
IF ((FileSystemObject.FolderExists(EWLD_PATH)) AND (EWLD_FILENAME<>"") AND (EWLD_FILEEXTENSION<>"")) THEN
EWLD_PATH_AND_FILENAME=EWLD_PATH&"\"&EWLD_FILENAME&"."&EWLD_FILEEXTENSION_NAME
EWLD_PATH_AND_FILENAME=Replace(EWLD_PATH_AND_FILENAME,vbCr,"")
EWLD_PATH_AND_FILENAME=Replace(EWLD_PATH_AND_FILENAME,vbLf,"")
IF (EWLD_VERSIONING= 9) or ((EWLD_VERSIONING<>0) and (EWLD_VERSIONING<>1) and (EWLD_VERSIONING<>2) and (EWLD_VERSIONING<>9)) THEN
'Reset Var to WinLine known value
EWLD_VERSIONING=1
IF (FileSystemObject.FileExists(EWLD_PATH_AND_FILENAME)) THEN
EWLD_FILENAME_ORIGINAL=EWLD_FILENAME
DO
DocVersion=DocVersion+1
EWLD_FILENAME=EWLD_FILENAME_ORIGINAL
EWLD_FILENAME=EWLD_FILENAME & DocVersionSeparator & DocVersion
EWLD_FILENAME=Replace(EWLD_FILENAME,vbCr,"")
EWLD_FILENAME=Replace(EWLD_FILENAME,vbLf,"")
EWLD_PATH_AND_FILENAME=EWLD_PATH & "\" & EWLD_FILENAME & "." & EWLD_FILEEXTENSION_NAME
EWLD_PATH_AND_FILENAME=Replace(EWLD_PATH_AND_FILENAME,vbCr,"")
EWLD_PATH_AND_FILENAME=Replace(EWLD_PATH_AND_FILENAME,vbLf,"")
LOOP UNTIL (FileSystemObject.FileExists(EWLD_PATH_AND_FILENAME) = False)
RI.Remove("%EWLD_FILENAME%")
RI.ADD "%EWLD_FILENAME%",EWLD_FILENAME& "." &EWLD_FILEEXTENSION_NAME
RI.ADD "%EWLD_PATH_AND_FILENAME%",EWLD_PATH_AND_FILENAME
END IF
END IF
IF (DebugMode = "Enabled") THEN
MSGBOX "FINAL EWLD_PATH_AND_FILENAME: "&vbCrLf&EWLD_PATH_AND_FILENAME&vbCrLf&vbCrLf&_
"FINAL EWLD_FILEEXTENSION: "&vbCrLf&EWLD_FILEEXTENSION&vbCrLf&vbCrLf&_
"FINAL EWLD_VERSIONING: "&vbCrLf&EWLD_VERSIONING&vbCrLf&vbCrLf&_
"RI includes "&RI.count&" Items.",,DEBUG_TITLE&" Final document settings"
END IF
IF (EWLD_FILENAME_PREVIEW<>"") THEN
Formtitle=EWLD_FILENAME_PREVIEW
END IF
'In preview, ExportOutput will not be executed!
ExportOutput EWLD_PATH_AND_FILENAME, EWLD_FILEEXTENSION, EWLD_VERSIONING
ExportDone="export_ready"
END IF
ELSEIF (EWLD_FILENAME_PREVIEW<>"") THEN
IF (DebugMode="Enabled") THEN
MsgBox "Only Preview Filename has been set!"&EWLD_FILENAME_PREVIEW,,DEBUG_TITLE
End if
Formtitle=EWLD_FILENAME_PREVIEW
ExportDone="export_ready"
END IF
'Call Macros
IF ((ExportType=2) or (ExportType=4) or (ExportType=5)) Then
For LoopCounter = 14 To 23
CALL_MAKRO_PRE_EXPORT=PROFILE_RESULT.Value(LoopCounter)
IF (CALL_MAKRO_PRE_EXPORT<>"") and (CALL_MAKRO_PRE_EXPORT<>LTRIM(RTRIM("<KEIN MAKRO>"))) Then
DIM MPs(32)
MPs(0) =DebugMode
MPs(1) =ExportDone
MPs(2) =MandatorNr
MPs(3) =EWLD_GUID
MPs(4) =EWLD_DESCRIPTION
MPs(5) =EWLD_PATH
MPs(6) =EWLD_FILENAME
MPs(7) =EWLD_FILEEXTENSION_NAME
MPs(8) =EWLD_PATH_AND_FILENAME
MPs(9) =AccountNr
MPs(10)=AccountName
MPs(11)=RunningNr
MPs(12)=DocNr
MPs(13)=ProjectNr
MPs(14)=ProgramDocType
MPs(15)=PostingType
MPs(16)=DocType
MPs(17)=WinLineCurrentUser
MPs(18)=DocVersion
MPs(19)=DocComment
MPs(20)=DocCreationDate
MPs(21)=DocChangedDate
MPs(22)=Addition1
MPs(23)=Addition2
MPs(24)=Addition3
MPs(25)=Addition4
MPs(26)=Addition5
MPs(27)=Addition6
MPs(28)=Addition7
MPs(29)=Addition8
MPs(30)=Addition9
MPs(31)=Addition10
pParams = MPs
CWLStart.MacroCommands.MRunMacro CALL_MAKRO_PRE_EXPORT, pParams
CWLStart.MacroCommands.MWait 500
End if
Next
End if
'Show Error
IF ((ExportDone<>"export_ready") and ((ExportType=2) or (ExportType=4) or (ExportType=5)) and (WinLineCurrentUser<>WebServiceUser) and (EWLD_GUID>0)) Then
msgbox "Es ist ein Fehler aufgetreten!"&vbCrLf&vbCrLf&_
EWLD_PATH&"\"&EWLD_FILENAME&vbCrLf&_
EWLD_FILEEXTENSION&" | "&EWLD_VERSIONING,vbInformation,"ACHTUNG: Export wird abgebrochen!"
End if
ResultValue = ""

View File

@ -0,0 +1,526 @@
' 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)
DOCEXPORT_MACRO = "DD_DOCEXPORT_WINLINE_PROGRAM_MACRO"
DOCEXPORT_MACROTRYS = 5
DOCEXPORT_PATH_AND_FILENAME = Value (500,354) ' <-- MOST Important Var in Script, depends on the output var of the DOCEXPORT Head-Formel
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"
TBDD_DOCEXPORT_CONFIG_MACROSQL = "[U001] = 1 AND [U004] LIKE '%Macro%' AND [U005] IS NULL AND [U006] IS NULL AND [U007] IS NULL AND [U008] IS NOT NULL AND [U012] IS NULL"
TBDD_DOCEXPORT_CONFIG_APPSQL = "[U001] = 1 AND [U004] LIKE '%APP%' AND [U005] IS NULL AND [U006] IS NULL AND [U007] IS NULL AND [U008] IS NULL AND [U012] IS NOT NULL"
TBDD_DOCEXPORT_HISTORY = "T652"
TBDD_DOCEXPORT_HISTORY_SQL = "INSERT INTO " & TBDD_DOCEXPORT_HISTORY & "(c000,c001,c002,c003,c004,c005,c006) Values ('%SQLCounter%','%DOCEXPORT_PATH%','%DOCEXPORT_FILENAME%','" & DOCEXPORT_PATH_AND_FILENAME & "','%Result%','%Username%','"& (Cstr(Now()) & "," & Right(Cstr(Timer() * 100),2)) &"')"
SET FileSystemObject = CreateObject("Scripting.FileSystemObject")
SET TBDD_DOCEXPORT_CONFIG_MACRO = CreateObject("Scripting.Dictionary")
SET TBDD_DOCEXPORT_CONFIG_APP = CreateObject("Scripting.Dictionary")
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 & vbCrLf & vbCrLf & _
"DOCEXPORT_MACRO: " & DOCEXPORT_MACRO & vbCrLf & _
"DOCEXPORT_PATH_AND_FILENAME: " & DOCEXPORT_PATH_AND_FILENAME,,"DEBUG - Info: WinLine Runtime Variables"
MSGBOX "Profile SQL:" & vbCrLf & TBDD_DOCEXPORT_PROFILE_SQL & vbCrLf & vbCrLf & _
"Var SQL: " & vbCrLf & TBDD_DOCEXPORT_CONFIG_VARSQL & vbCrLf & vbCrLf & _
"Macro SQL: " & vbCrLf & TBDD_DOCEXPORT_CONFIG_MACROSQL & vbCrLf & vbCrLf & _
"App SQL: " & vbCrLf & TBDD_DOCEXPORT_CONFIG_APPSQL & vbCrLf & vbCrLf & _
"History SQL: "& vbCrLf & TBDD_DOCEXPORT_HISTORY_SQL,,"DEBUG - Info: SQL Commands (not final!)"
END IF
IF (DOCEXPORT_PATH_AND_FILENAME <> "") Then
'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 "RUN_MACRO_GUID: " & TBDD_DOCEXPORT_PROFILE_RESULT.Value(16) & vbCrLf & _
"RUN_MACRO: " & TBDD_DOCEXPORT_PROFILE_RESULT.Value(17) & vbCrLf & _
"RUN_MACRO_PARAMETER1: " & TBDD_DOCEXPORT_PROFILE_RESULT.Value(18) & vbCrLf & _
"RUN_MACRO_PARAMETER2: " & TBDD_DOCEXPORT_PROFILE_RESULT.Value(19) & vbCrLf & _
"RUN_MACRO_PARAMETER3: " & TBDD_DOCEXPORT_PROFILE_RESULT.Value(20) & vbCrLf & vbCrLf & _
"RUN_APP_GUID: " & TBDD_DOCEXPORT_PROFILE_RESULT.Value(21) & vbCrLf & _
"RUN_APP: " & TBDD_DOCEXPORT_PROFILE_RESULT.Value(22) & vbCrLf & _
"RUN_APP_PARAMETER1: " & TBDD_DOCEXPORT_PROFILE_RESULT.Value(23) & vbCrLf & _
"RUN_APP_PARAMETER2: " & TBDD_DOCEXPORT_PROFILE_RESULT.Value(24) & vbCrLf & _
"RUN_APP_PARAMETER3: " & TBDD_DOCEXPORT_PROFILE_RESULT.Value(25) & vbCrLf & vbCrLf & _
"OPEN_FILE_AFTER_EXPORT: " & TBDD_DOCEXPORT_PROFILE_RESULT.Value(26) & vbCrLf & _
"VERIFY_EXPORT_AND_LOG2DB: " & TBDD_DOCEXPORT_PROFILE_RESULT.Value(27) & vbCrLf & _
"VERIFY_EXPORT_AND_LOG2FILE: "& TBDD_DOCEXPORT_PROFILE_RESULT.Value(28) & vbCrLf & _
"VERIFY_EXPORT_AND_MSGBOX: " & TBDD_DOCEXPORT_PROFILE_RESULT.Value(29),,"DEBUG - Info: document profile from Database table "& TBDD_DOCEXPORT_PROFILE
END IF
RUN_MACRO_GUID = TBDD_DOCEXPORT_PROFILE_RESULT.Value(16)
RUN_MACRO = TBDD_DOCEXPORT_PROFILE_RESULT.Value(17)
RUN_MACRO_PARAMETER1 = TBDD_DOCEXPORT_PROFILE_RESULT.Value(18)
RUN_MACRO_PARAMETER2 = TBDD_DOCEXPORT_PROFILE_RESULT.Value(19)
RUN_MACRO_PARAMETER3 = TBDD_DOCEXPORT_PROFILE_RESULT.Value(20)
RUN_APP_GUID = TBDD_DOCEXPORT_PROFILE_RESULT.Value(21)
RUN_APP = TBDD_DOCEXPORT_PROFILE_RESULT.Value(22)
RUN_APP_PARAMETER1 = TBDD_DOCEXPORT_PROFILE_RESULT.Value(23)
RUN_APP_PARAMETER2 = TBDD_DOCEXPORT_PROFILE_RESULT.Value(24)
RUN_APP_PARAMETER3 = TBDD_DOCEXPORT_PROFILE_RESULT.Value(25)
OPEN_FILE_AFTER_EXPORT = TBDD_DOCEXPORT_PROFILE_RESULT.Value(26)
VERIFY_EXPORT_AND_LOG2DB = TBDD_DOCEXPORT_PROFILE_RESULT.Value(27)
VERIFY_EXPORT_AND_LOG2FILE = TBDD_DOCEXPORT_PROFILE_RESULT.Value(28)
VERIFY_EXPORT_AND_MSGBOX = TBDD_DOCEXPORT_PROFILE_RESULT.Value(29)
'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
'Code 4 getting macros
IF RUN_MACRO_GUID <> "" THEN
TBDD_DOCEXPORT_CONFIG_MACROSQL = TBDD_DOCEXPORT_CONFIG_MACROSQL & " AND [u000] IN (" & RUN_MACRO_GUID & ")"
END IF
SET TBDD_DOCEXPORT_CONFIG_MACROSQL_RESULT = CWLStart.CurrentCompany.SearchRecord(TBDD_DOCEXPORT_CONFIG, TBDD_DOCEXPORT_CONFIG_MACROSQL)
IF Err.Number <> 0 THEN
MSGBOX "Error Code: "& Err.Number & vbCrLf & _
"Error Description: "& Err.Description,,"ERROR: Macro(s) from Database table "& TBDD_DOCEXPORT_CONFIG
Err.Clear
ELSE
IF TBDD_DOCEXPORT_CONFIG_MACROSQL_RESULT = -1 Then
IF DebugMode = "Enabled" THEN
MSGBOX "No Rows found, SQL: "& TBDD_DOCEXPORT_CONFIG_MACROSQL,,"DEBUG - Info: Macros(s) from Database table "& TBDD_DOCEXPORT_CONFIG
END IF
ELSE
FOR LoopCounter = 1 To TBDD_DOCEXPORT_CONFIG_MACROSQL_RESULT.RowCount
IF DebugMode = "Enabled" THEN
MSGBOX "Macro: " & TBDD_DOCEXPORT_CONFIG_MACROSQL_RESULT.Value(8) & vbCrLf & _
"Parameter1: "& TBDD_DOCEXPORT_CONFIG_MACROSQL_RESULT.Value(9) & vbCrLf & _
"Parameter2: "& TBDD_DOCEXPORT_CONFIG_MACROSQL_RESULT.Value(10) & vbCrLf & _
"Parameter3: "& TBDD_DOCEXPORT_CONFIG_MACROSQL_RESULT.Value(11),,"DEBUG - Info: "& LoopCounter &" of "& TBDD_DOCEXPORT_CONFIG_MACROSQL_RESULT.RowCount &" Functions from Database table "& TBDD_DOCEXPORT_CONFIG
END IF
TBDD_DOCEXPORT_CONFIG_MACRO(LoopCounter) = Array(TBDD_DOCEXPORT_CONFIG_MACROSQL_RESULT.Value(8),TBDD_DOCEXPORT_CONFIG_MACROSQL_RESULT.Value(9),TBDD_DOCEXPORT_CONFIG_MACROSQL_RESULT.Value(10),TBDD_DOCEXPORT_CONFIG_MACROSQL_RESULT.Value(11))
TBDD_DOCEXPORT_CONFIG_MACROSQL_RESULT.NextRecord
NEXT
END IF
END IF
'Code 4 getting Apps
IF RUN_APP_GUID <> "" THEN
TBDD_DOCEXPORT_CONFIG_APPSQL = TBDD_DOCEXPORT_CONFIG_APPSQL & " AND [u000] IN (" & RUN_APP_GUID & ")"
END IF
SET TBDD_DOCEXPORT_CONFIG_APPSQL_RESULT = CWLStart.CurrentCompany.SearchRecord(TBDD_DOCEXPORT_CONFIG, TBDD_DOCEXPORT_CONFIG_APPSQL)
IF Err.Number <> 0 THEN
MSGBOX "Error Code: "& Err.Number & vbCrLf & _
"Error Description: "& Err.Description,,"ERROR: App(s) from Database table "& TBDD_DOCEXPORT_CONFIG
Err.Clear
ELSE
IF TBDD_DOCEXPORT_CONFIG_APPSQL_RESULT = -1 Then
IF DebugMode = "Enabled" THEN
MSGBOX "No Rows found, SQL: "& TBDD_DOCEXPORT_CONFIG_APPSQL,,"DEBUG - Info: App(s) from Database table "& TBDD_DOCEXPORT_CONFIG
END IF
ELSE
FOR LoopCounter = 1 To TBDD_DOCEXPORT_CONFIG_APPSQL_RESULT.RowCount
IF DebugMode = "Enabled" THEN
MSGBOX "App: " & TBDD_DOCEXPORT_CONFIG_APPSQL_RESULT.Value(12) & vbCrLf & _
"Parameter1: "& TBDD_DOCEXPORT_CONFIG_APPSQL_RESULT.Value(13) & vbCrLf & _
"Parameter2: "& TBDD_DOCEXPORT_CONFIG_APPSQL_RESULT.Value(14) & vbCrLf & _
"Parameter3: "& TBDD_DOCEXPORT_CONFIG_APPSQL_RESULT.Value(15),,"DEBUG - Info: "& LoopCounter &" of "& TBDD_DOCEXPORT_CONFIG_APPSQL_RESULT.RowCount &" App(s) from Database table "& TBDD_DOCEXPORT_CONFIG
END IF
TBDD_DOCEXPORT_CONFIG_APP(LoopCounter) = Array(TBDD_DOCEXPORT_CONFIG_APPSQL_RESULT.Value(12),TBDD_DOCEXPORT_CONFIG_APPSQL_RESULT.Value(13),TBDD_DOCEXPORT_CONFIG_APPSQL_RESULT.Value(14),TBDD_DOCEXPORT_CONFIG_APPSQL_RESULT.Value(15))
TBDD_DOCEXPORT_CONFIG_APPSQL_RESULT.NextRecord
NEXT
END IF
END IF
END IF
END IF
'########## main part ##########
IF (TBDD_DOCEXPORT_CONFIG_MACROSQL_RESULT > 0) OR (TBDD_DOCEXPORT_CONFIG_APPSQL_RESULT > 0) OR (RUN_MACRO <> "") OR (RUN_APP <> "") OR (OPEN_FILE_AFTER_EXPORT = 1) OR (VERIFY_EXPORT_AND_LOG2DB > 0) OR (VERIFY_EXPORT_AND_LOG2FILE > 0) OR (VERIFY_EXPORT_AND_MSGBOX > 0) THEN
IF DebugMode = "Enabled" THEN
MSGBOX "Calling Macro: "& DocExport_Macro,,"DEBUG - Info: Post processing..."
END IF
'= MParameter 20...
MacroParameter(0) = DebugMode
MacroParameter(1) = TBDD_DOCEXPORT_PROFILE
MacroParameter(2) = TBDD_DOCEXPORT_PROFILE_SQL
MacroParameter(3) = "SET-LATER"
MacroParameter(4) = DOCEXPORT_PATH_AND_FILENAME
MacroParameter(5) = DOCEXPORT_MACROTRYS
MacroParameter(6) = ""
'Multiple macros from config SQLTB
IF TBDD_DOCEXPORT_CONFIG_MACROSQL_RESULT > 0 Then
FOR LoopCounter = 1 To TBDD_DOCEXPORT_CONFIG_MACROSQL_RESULT.RowCount
RUN_MACROS = TBDD_DOCEXPORT_CONFIG_MACRO(LoopCounter)(0)
RUN_MACROS_PARAMETER1 = TBDD_DOCEXPORT_CONFIG_MACRO(LoopCounter)(1)
RUN_MACROS_PARAMETER2 = TBDD_DOCEXPORT_CONFIG_MACRO(LoopCounter)(2)
RUN_MACROS_PARAMETER3 = TBDD_DOCEXPORT_CONFIG_MACRO(LoopCounter)(3)
ReplaceKeys = ReplaceItems.keys
For LoopCounter2 = 0 To ReplaceItems.Count -1
IF InStr(RUN_MACROS,ReplaceKeys(LoopCounter2)) > 0 Then
RUN_MACROS = Replace(RUN_MACROS,ReplaceKeys(LoopCounter),ReplaceItems(ReplaceKeys(LoopCounter2)))
END IF
IF InStr(RUN_MACROS_PARAMETER1,ReplaceKeys(LoopCounter2)) > 0 Then
RUN_MACROS_PARAMETER1 = Replace(RUN_MACROS_PARAMETER1,ReplaceKeys(LoopCounter2),ReplaceItems(ReplaceKeys(LoopCounter2)))
END IF
IF InStr(RUN_MACROS_PARAMETER2,ReplaceKeys(LoopCounter2)) > 0 Then
RUN_MACROS_PARAMETER2 = Replace(RUN_MACROS_PARAMETER2,ReplaceKeys(LoopCounter2),ReplaceItems(ReplaceKeys(LoopCounter2)))
END IF
IF InStr(RUN_MACROS_PARAMETER3,ReplaceKeys(LoopCounter2)) > 0 Then
RUN_MACROS_PARAMETER3 = Replace(RUN_MACROS_PARAMETER3,ReplaceKeys(LoopCounter2),ReplaceItems(ReplaceKeys(LoopCounter2)))
END IF
Next
IF DebugMode = "Enabled" THEN
MSGBOX "RUN_MACROS: "& RUN_MACROS & vbCrLf & _
"RUN_MACROS_PARAMETER1: "& RUN_MACROS_PARAMETER1 & vbCrLf & _
"RUN_MACROS_PARAMETER2: "& RUN_MACROS_PARAMETER2 & vbCrLf & _
"RUN_MACROS_PARAMETER3: "& RUN_MACROS_PARAMETER3 & vbCrLf & vbCrLf & _
"ReplaceItems includes "& ReplaceItems.count &" Items.",,"DEBUG - Info: RUN_MACROS Call AFTER replace routine"
END IF
MacroParameter(3) ="RUN_MACRO"
MacroParameter(7) = RUN_MACROS
MacroParameter(8) = RUN_MACROS_PARAMETER1
MacroParameter(9) = RUN_MACROS_PARAMETER2
MacroParameter(10)= RUN_MACROS_PARAMETER3
pParams = MacroParameter
CWLStart.MacroCommands.MRunMacroSuspended RUN_MACROS, pParams
CWLStart.MacroCommands.MWait 500
NEXT
END IF
'Multiple apps from config SQLTB
IF TBDD_DOCEXPORT_CONFIG_APPSQL_RESULT > 0 Then
FOR LoopCounter = 1 To TBDD_DOCEXPORT_CONFIG_APPSQL_RESULT.RowCount
RUN_APPS = TBDD_DOCEXPORT_CONFIG_APP(LoopCounter)(0)
RUN_APPS_PARAMETER1 = TBDD_DOCEXPORT_CONFIG_APP(LoopCounter)(1)
RUN_APPS_PARAMETER2 = TBDD_DOCEXPORT_CONFIG_APP(LoopCounter)(2)
RUN_APPS_PARAMETER3 = TBDD_DOCEXPORT_CONFIG_APP(LoopCounter)(3)
ReplaceKeys = ReplaceItems.keys
For LoopCounter2 = 0 To ReplaceItems.Count -1
IF InStr(RUN_APPS,ReplaceKeys(LoopCounter2)) > 0 Then
RUN_APPS = Replace(RUN_APPS,ReplaceKeys(LoopCounter2),ReplaceItems(ReplaceKeys(LoopCounter2)))
END IF
IF InStr(RUN_APPS_PARAMETER1,ReplaceKeys(LoopCounter2)) > 0 Then
RUN_APPS_PARAMETER1 = Replace(RUN_APPS_PARAMETER1,ReplaceKeys(LoopCounter2),ReplaceItems(ReplaceKeys(LoopCounter2)))
END IF
IF InStr(RUN_APPS_PARAMETER2,ReplaceKeys(LoopCounter2)) > 0 Then
RUN_APPS_PARAMETER2 = Replace(RUN_APPS_PARAMETER2,ReplaceKeys(LoopCounter2),ReplaceItems(ReplaceKeys(LoopCounter2)))
END IF
IF InStr(RUN_APPS_PARAMETER3,ReplaceKeys(LoopCounter2)) > 0 Then
RUN_APPS_PARAMETER3 = Replace(RUN_APPS_PARAMETER3,ReplaceKeys(LoopCounter2),ReplaceItems(ReplaceKeys(LoopCounter2)))
END IF
Next
IF DebugMode = "Enabled" THEN
MSGBOX "RUN_APPS: "& RUN_APPS & vbCrLf & _
"RUN_APPS_PARAMETER1: "& RUN_APPS_PARAMETER1 & vbCrLf & _
"RUN_APPS_PARAMETER2: "& RUN_APPS_PARAMETER2 & vbCrLf & _
"RUN_APPS_PARAMETER3: "& RUN_APPS_PARAMETER3 & vbCrLf & vbCrLf & _
"ReplaceItems includes "& ReplaceItems.count &" Items.",,"DEBUG - Info: RUN_APPS Call AFTER replace routine"
END IF
MacroParameter(3) ="RUN_APP"
MacroParameter(7) = RUN_APPS
MacroParameter(8) = RUN_APPS_PARAMETER1
MacroParameter(9) = RUN_APPS_PARAMETER2
MacroParameter(10)= RUN_APPS_PARAMETER3
pParams = MacroParameter
CWLStart.MacroCommands.MRunMacroSuspended RUN_APP, pParams
CWLStart.MacroCommands.MWait 500
NEXT
END IF
'ONE macro from profile SQLTB
IF RUN_MACRO <> "" THEN
ReplaceKeys = ReplaceItems.keys
For LoopCounter = 0 To ReplaceItems.Count -1
IF InStr(RUN_MACRO,ReplaceKeys(LoopCounter)) > 0 Then
RUN_MACRO = Replace(RUN_MACRO,ReplaceKeys(LoopCounter),ReplaceItems(ReplaceKeys(LoopCounter)))
END IF
IF InStr(RUN_MACRO_PARAMETER1,ReplaceKeys(LoopCounter)) > 0 Then
RUN_MACRO_PARAMETER1 = Replace(RUN_MACRO_PARAMETER1,ReplaceKeys(LoopCounter),ReplaceItems(ReplaceKeys(LoopCounter)))
END IF
IF InStr(RUN_MACRO_PARAMETER2,ReplaceKeys(LoopCounter)) > 0 Then
RUN_MACRO_PARAMETER2 = Replace(RUN_MACRO_PARAMETER2,ReplaceKeys(LoopCounter),ReplaceItems(ReplaceKeys(LoopCounter)))
END IF
IF InStr(RUN_MACRO_PARAMETER3,ReplaceKeys(LoopCounter)) > 0 Then
RUN_MACRO_PARAMETER3 = Replace(RUN_MACRO_PARAMETER3,ReplaceKeys(LoopCounter),ReplaceItems(ReplaceKeys(LoopCounter)))
END IF
Next
IF DebugMode = "Enabled" THEN
MSGBOX "RUN_MACRO: "& RUN_MACRO & vbCrLf & _
"RUN_MACRO_PARAMETER1: "& RUN_MACRO_PARAMETER1 & vbCrLf & _
"RUN_MACRO_PARAMETER2: "& RUN_MACRO_PARAMETER2 & vbCrLf & _
"RUN_MACRO_PARAMETER3: "& RUN_MACRO_PARAMETER3 & vbCrLf & vbCrLf & _
"ReplaceItems includes "& ReplaceItems.count &" Items.",,"DEBUG - Info: RUN_MACRO Call AFTER replace routine"
END IF
MacroParameter(3) ="RUN_MACRO"
MacroParameter(7) = RUN_MACRO
MacroParameter(8) = RUN_MACRO_PARAMETER1
MacroParameter(9) = RUN_MACRO_PARAMETER2
MacroParameter(10)= RUN_MACRO_PARAMETER3
pParams = MacroParameter
CWLStart.MacroCommands.MRunMacroSuspended RUN_MACRO, pParams
CWLStart.MacroCommands.MWait 500
END IF
'ONE app from profile SQLTB
IF RUN_APP <> "" Then
ReplaceKeys = ReplaceItems.keys
For LoopCounter = 0 To ReplaceItems.Count -1
IF InStr(RUN_APP,ReplaceKeys(LoopCounter)) > 0 Then
RUN_APP = Replace(RUN_APP,ReplaceKeys(LoopCounter),ReplaceItems(ReplaceKeys(LoopCounter)))
END IF
IF InStr(RUN_APP_PARAMETER1,ReplaceKeys(LoopCounter)) > 0 Then
RUN_APP_PARAMETER1 = Replace(RUN_APP_PARAMETER1,ReplaceKeys(LoopCounter),ReplaceItems(ReplaceKeys(LoopCounter)))
END IF
IF InStr(RUN_APP_PARAMETER2,ReplaceKeys(LoopCounter)) > 0 Then
RUN_APP_PARAMETER2 = Replace(RUN_APP_PARAMETER2,ReplaceKeys(LoopCounter),ReplaceItems(ReplaceKeys(LoopCounter)))
END IF
IF InStr(RUN_APP_PARAMETER3,ReplaceKeys(LoopCounter)) > 0 Then
RUN_APP_PARAMETER3 = Replace(RUN_APP_PARAMETER3,ReplaceKeys(LoopCounter),ReplaceItems(ReplaceKeys(LoopCounter)))
END IF
Next
IF DebugMode = "Enabled" THEN
MSGBOX "RUN_APP: "& RUN_APP & vbCrLf & _
"RUN_APP_PARAMETER1: "& RUN_APP_PARAMETER1 & vbCrLf & _
"RUN_APP_PARAMETER2: "& RUN_APP_PARAMETER2 & vbCrLf & _
"RUN_APP_PARAMETER3: "& RUN_APP_PARAMETER3 & vbCrLf & vbCrLf & _
"ReplaceItems includes "& ReplaceItems.count &" Items.",,"DEBUG - Info: RUN_APP Call AFTER replace routine"
END IF
MacroParameter(3) ="RUN_APP"
MacroParameter(7) = RUN_APP
MacroParameter(8) = RUN_APP_PARAMETER1
MacroParameter(9) = RUN_APP_PARAMETER2
MacroParameter(10)= RUN_APP_PARAMETER3
pParams = MacroParameter
CWLStart.MacroCommands.MRunMacroSuspended DocExport_Macro, pParams
CWLStart.MacroCommands.MWait 500
END IF
IF OPEN_FILE_AFTER_EXPORT = 1 Then
MacroParameter(3) = "OPEN_FILE_AFTER_EXPORT"
pParams = MacroParameter
Cwlstart.MacroCommands.MRunMacroSuspended DocExport_Macro, pParams
CWLStart.MacroCommands.MWait 500
End IF
IF VERIFY_EXPORT_AND_LOG2DB = 1 Then
MacroParameter(3) = "VERIFY_EXPORT_AND_LOG2DB"
MacroParameter(7) = TBDD_DOCEXPORT_HISTORY
MacroParameter(8) = TBDD_DOCEXPORT_HISTORY_SQL
pParams = MacroParameter
Cwlstart.MacroCommands.MRunMacroSuspended DocExport_Macro, pParams
CWLStart.MacroCommands.MWait 500
End IF
IF VERIFY_EXPORT_AND_LOG2FILE = 1 Then
MacroParameter(3) = "VERIFY_EXPORT_AND_LOG2FILE"
pParams = MacroParameter
Cwlstart.MacroCommands.MRunMacroSuspended DocExport_Macro, pParams
CWLStart.MacroCommands.MWait 500
End IF
IF VERIFY_EXPORT_AND_MSGBOX = 1 Then
MacroParameter(3) = "VERIFY_EXPORT_AND_MSGBOX"
pParams = MacroParameter
Cwlstart.MacroCommands.MRunMacroSuspended DocExport_Macro, pParams
CWLStart.MacroCommands.MWait 500
End IF
End IF
Else
IF DebugMode = "Enabled" THEN
MSGBOX "No post processing, DOCEXPORT_PATH_AND_FILENAME ist empty",,"DEBUG - Info: DOCEXPORT PDFE Footer Formel"
End IF
END IF
ResultValue = ""

View File

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

@ -0,0 +1,137 @@
-- Export-WinLineDoc - Standard-Profile
-- =================================================================
-- Dieses Skript legt vordefnierte Profile und Konfigurationen an.
--
-- ToDos:
-- 1. DB kontrollieren
-- 2. Tabellen kontrollieren
-- 3. Mehrere DBs = mehrere Importe
--
-- =================================================================
-- 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: 04.07.2021 / MD
-- Version Date / Editor: 04.07.2021 / MD
-- Version Number: 1.0.0.0
-- =================================================================
-- History:
-- 04.07.2021 / MK - Erstellung
--USE [CWLDATEN]
--GO
delete FROM [t650]
delete FROM [t651]
delete FROM [t652]
--------------------------------------------------------------------------
INSERT [dbo].[t650] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [U010], [U011], [U012], [U013], [U014]) VALUES (1, N'1', N'Mandant Kurzname', N'ALL', N'CUSTOM_VARIABLE', N'%KURZNAME_MANDANT%', N'TEXT', N'Toys&Bikes', 0, 0, CAST(N'1970-01-01T00:00:00.000' AS DateTime), N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
GO
INSERT [dbo].[t650] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [U010], [U011], [U012], [U013], [U014]) VALUES (2, N'1', N'Exportpfad', N'ALL', N'CUSTOM_VARIABLE', N'%EXPORTPATH%', N'TEXT', N'c:\WinLine\Dokumentablage', 0, 0, CAST(N'1970-01-01T00:00:00.000' AS DateTime), N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
GO
--------------------------------------------------------------------------
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (1, 1, N'Angebot (debitorisch)', N'ALL', N'1', N'1', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Kunden-Angebot\%YEAR%\%MONTH%', N'%MandantenNr%-AANG-%AngebotsNr%-%KontoName%
', N'%MandantenNr%-AANG-%AngebotsNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
GO
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (2, 1, N'Angebot-Storno (debitorisch)', N'ALL', N'1', N'11', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Kunden-Angebot-Storno\%YEAR%\%MONTH%', N'%MandantenNr%-AANG-Storno-%AngebotsNr%-%KontoName%
', N'%MandantenNr%-AANG-Storno-%AngebotsNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
GO
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (3, 1, N'Auftrag (debitorisch)', N'ALL', N'1', N'2', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Kunden-Auftrag\%YEAR%\%MONTH%
', N'%MandantenNr%-AAB-%AuftragsNr%-%KontoName%
', N'%MandantenNr%-AAB-%AuftragsNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
GO
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (4, 1, N'Auftrag-Storno (debitorisch)', N'ALL', N'1', N'12', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Kunden-Auftrag-Storno\%YEAR%\%MONTH%
', N'%MandantenNr%-AAB-Storno-%AuftragsNr%-%KontoName%
', N'%MandantenNr%-AAB-Storno-%AuftragsNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
GO
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (5, 1, N'Lieferschein (debitorisch)', N'ALL', N'1', N'3', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Kunden-Lieferschein\%YEAR%\%MONTH%
', N'%MandantenNr%-ALS-%LieferscheinNr%-%KontoName%
', N'%MandantenNr%-ALS-%LieferscheinNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
GO
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (6, 1, N'Lieferschein-Storno (debitorisch)', N'ALL', N'1', N'13', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Kunden-Lieferschein-Storno\%YEAR%\%MONTH%
', N'%MandantenNr%-ALS-Storno-%LieferscheinNr%-%KontoName%
', N'%MandantenNr%-ALS-Storno-%LieferscheinNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
GO
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (7, 1, N'Rechnung (debitorisch)', N'ALL', N'1', N'4', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Kunden-Rechnung\%YEAR%\%MONTH%
', N'%MandantenNr%-ARE-%RechnungsNr%-%KontoName%
', N'%MandantenNr%-ARE-%RechnungsNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
GO
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (8, 1, N'Rechnung-Storno (debitorisch)', N'ALL', N'1', N'14', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Kunden-Rechnung-Storno\%YEAR%\%MONTH%
', N'%MandantenNr%-ARE-Storno-%RechnungsNr%-%KontoName%
', N'%MandantenNr%-ARE-Storno-%RechnungsNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
GO
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (9, 1, N'Anfrage (kreditorisch)', N'ALL', N'2', N'1', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Lieferanten-Anfrage\%YEAR%\%MONTH%
', N'%MandantenNr%-AANF-%AnfragenNr%-%KontoName%
', N'%MandantenNr%-AANF-%AnfragenNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
GO
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (10, 1, N'Anfrage-Storno (kreditorisch)', N'ALL', N'2', N'11', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Lieferanten-Anfrage-Storno\%YEAR%\%MONTH%
', N'%MandantenNr%-AANF-Storno-%AnfragenNr%-%KontoName%
', N'%MandantenNr%-AANF-Storno-%AnfragenNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
GO
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (11, 1, N'Bestellung (kreditorisch)', N'ALL', N'2', N'2', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Lieferanten-Bestellung\%YEAR%\%MONTH%
', N'%MandantenNr%-ABE-%BestellNr%-%KontoName%
', N'%MandantenNr%-ABE-%BestellNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
GO
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (12, 1, N'Bestellung-Storno (kreditorisch)', N'ALL', N'2', N'12', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Lieferanten-Bestellung-Storno\%YEAR%\%MONTH%
', N'%MandantenNr%-ABE-Storno-%BestellNr%-%KontoName%
', N'%MandantenNr%-ABE-Storno-%BestellNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
GO
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (13, 1, N'Lieferschein (kreditorisch)', N'ALL', N'2', N'3', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Lieferanten-Lieferschein\%YEAR%\%MONTH%
', N'%MandantenNr%-ELS-%LieferscheinNr%-%KontoName%
', N'%MandantenNr%-ELS-%LieferscheinNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
GO
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (14, 1, N'Lieferschein-Storno (kreditorisch)', N'ALL', N'2', N'13', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Lieferanten-Lieferschein-Storno\%YEAR%\%MONTH%
', N'%MandantenNr%-ELS-Storno-%LieferscheinNr%-%KontoName%
', N'%MandantenNr%-ELS-Storno-%LieferscheinNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
GO
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (15, 1, N'Rechnung (kreditorisch)', N'ALL', N'2', N'4', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Lieferanten-Rechnung\%YEAR%\%MONTH%
', N'%MandantenNr%-ERE-%RechnungsNr%-%KontoName%
', N'%MandantenNr%-ERE-%RechnungsNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
GO
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (16, 1, N'Rechnung-Storno (kreditorisch)', N'ALL', N'2', N'14', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Lieferanten-Rechnung-Storno\%YEAR%\%MONTH%
', N'%MandantenNr%-ERE-Storno-%RechnungsNr%-%KontoName%
', N'%MandantenNr%-ERE-Storno-%RechnungsNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
GO
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (17, 1, N'Teillieferschein (debitorisch)', N'ALL', N'1', N'-3', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Kunden-Teillieferschein\%YEAR%\%MONTH%
', N'%MandantenNr%-ATLS-%LieferscheinNr%-%KontoName%
', N'%MandantenNr%-ATLS-%LieferscheinNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
GO
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (18, 1, N'Gutschrift (debitorisch)', N'ALL', N'1', N'4', NULL, N'NegativAmount', NULL, NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Kunden-Gutschrift\%YEAR%\%MONTH%
', N'%MandantenNr%-AGU-%RechnungsNr%-%KontoName%
', N'%MandantenNr%-AGU-%RechnungsNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
GO
INSERT [dbo].[t651] ([u000], [u001], [u002], [u003], [u004], [u005], [u006], [u007], [u008], [u009], [u010], [u011], [u012], [u013], [u014], [u015], [u016], [u017], [u018], [u019], [u020], [u021], [u022], [u023], [u024], [u025], [U026], [U027], [U028], [U029], [U030], [U031], [U032]) VALUES (19, 1, N'Rechnungskorrektur (debitorisch)', N'ALL', N'1', N'4', NULL, N'NegativAmount', N'Correction', NULL, NULL, NULL, NULL, NULL, N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'<KEIN MAKRO>', N'%EXPORTPATH%\%MandantenNr%\Kunden-Rechnungskorrektur\%YEAR%\%MONTH%
', N'%MandantenNr%-AREK-%RechnungsNr%-%KontoName%
', N'%MandantenNr%-AREK-%RechnungsNr%-%KontoName%
', 5, 9, N'DigitalData', CAST(N'2021-07-16T00:00:00.000' AS DateTime), NULL, NULL)
GO
--------------------------------------------------------------------------
SELECT * FROM [t650]
SELECT * FROM [t651]
SELECT * FROM [t652]

View File

@ -0,0 +1,666 @@
' VB Script Document
'
' Export Script for WinLine documents.
' Configuration has to be done in the additional fields in the "WinLine Mandantenstamm"
'
' Digital Data
' Ludwig-Rinn-Straße 16
' 35452 Heuchelheim
' Tel.: 0641 / 202360
' E-Mail: info(at)didalog.de
'
' Version Number: 1.0.1.0
' Version Date: 15.07.2019
On Error Resume Next
'#-----------------------------------------------------------------------------------------------------#
'############################################ set variables ############################################
'#-----------------------------------------------------------------------------------------------------#
DIM DateTime, SplitChar, ReplaceSpecialChar, DocExtension, DocVersion, DocVersionSeparator, DocType, MandatorShortName, DocAccountNumber, DocAANGExportPath, DocAABExportPath, DocALSExportPath, DocAREExportPath
DIM FileSystemObject, Shell, DocAANGConvention, DocAABConvention, DocALSConvention, DocAREConvention, DocAANGNumber, DocAABNumber, DocALSNumber, DocARENumber, DocTargetPath, DocTargetFileName, FullPath
SET FileSystemObject = CreateObject("Scripting.FileSystemObject")
SET Shell = CreateObject("WScript.Shell")
'Standard / default variables.
DateTime = now
SplitChar = "|"
ReplaceSpecialChar = " "
DocExtension = ".pdf"
DocExportCheck = "true"
DocExportCheckTry = 0
DocExportCheckMaxTrys = 10
DocVersion = 1
DocVersionSeparator = "~"
Timestamp = ((year(DateTime)*100 + month(DateTime))*100 + day(DateTime))*10000 + hour(DateTime)*100 + minute(DateTime)
DocType = Value (25,139) 'WinLine Belegstufe
RecordNumber = Value (25,22) 'WinLine Laufnummer
PostingType = Value (357,6) 'WinLine Buchungsart (Debitorisch = 1 / Kreditorisch = 2)
Amount = Value (0,201) 'WinLine Betrag (Artikel, Gutschrift)
MandatorShortName = TRIM(CSTR(Value (1,200))) 'WinLine Mandantenkürzel (individual Feld)
DocAccountNumber = TRIM(CSTR(Value (0,30))) 'WinLine Kontonummer (Debitor / Kreditor)
DocAANGNumber = TRIM(CSTR(Value (0,34))) 'WinLine Angebotsnummer
DocAABNumber = TRIM(CSTR(Value (0,35))) 'WinLine Auftragsnummer
DocALSNumber = TRIM(CSTR(Value (0,36))) 'WinLine Lieferscheinnummer
DocARENumber = TRIM(CSTR(Value (0,37))) 'WinLine Rechnungsnummer
DocAANFNumber = TRIM(CSTR(Value (0,34))) 'WinLine Anfragennummer
DocABENumber = TRIM(CSTR(Value (0,35))) 'WinLine Bestellnummer
DocAANGExportPath = TRIM(CSTR(Split(Value (1,201),SplitChar)(0))) 'WinLine Exportpfad für Angebote (individual Feld)
DocAABExportPath = TRIM(CSTR(Split(Value (1,202),SplitChar)(0))) 'WinLine Exportpfad für Aufträge (individual Feld)
DocALSExportPath = TRIM(CSTR(Split(Value (1,203),SplitChar)(0))) 'WinLine Exportpfad für Lieferscheine (individual Feld)
DocAREExportPath = TRIM(CSTR(Split(Value (1,204),SplitChar)(0))) 'WinLine Exportpfad für Rechnungen (individual Feld)
DocAGUExportPath = TRIM(CSTR(Split(Value (1,205),SplitChar)(0))) 'WinLine Exportpfad für Gutschriften (individual Feld)
DocAANFExportPath = TRIM(CSTR(Split(Value (1,206),SplitChar)(0))) 'WinLine Exportpfad für Anfragen (individual Feld)
DocABEExportPath = TRIM(CSTR(Split(Value (1,207),SplitChar)(0))) 'WinLine Exportpfad für Bestellungen (individual Feld)
DocAANGConvention = TRIM(CSTR(Split(Value (1,201),SplitChar)(1))) 'WinLine Benennungsschema für Angebote (individual Feld)
DocAABConvention = TRIM(CSTR(Split(Value (1,202),SplitChar)(1))) 'WinLine Benennungsschema für Aufträge (individual Feld)
DocALSConvention = TRIM(CSTR(Split(Value (1,203),SplitChar)(1))) 'WinLine Benennungsschema für Lieferscheine (individual Feld)
DocAREConvention = TRIM(CSTR(Split(Value (1,204),SplitChar)(1))) 'WinLine Benennungsschema für Rechnungen (individual Feld)
DocAGUConvention = TRIM(CSTR(Split(Value (1,205),SplitChar)(1))) 'WinLine Benennungsschema für Gutschriften (individual Feld)
DocAANFConvention = TRIM(CSTR(Split(Value (1,206),SplitChar)(1))) 'WinLine Benennungsschema für Anfragen (individual Feld)
DocABEConvention = TRIM(CSTR(Split(Value (1,207),SplitChar)(1))) 'WinLine Benennungsschema für Bestellungen (individual Feld)
MandatorSpecificVarCount = 50
MandatorSpecificVarCounter = 0
i = 1 : s = ""
'Loop for mass declaration of Mandator specific Variables
DO
s = s & i '& ", "
MandatorSpecificVarCounter = MandatorSpecificVarCounter+1
msgbox i
LOOP WHILE MandatorSpecificVarCounter < MandatorSpecificVarCount
MandatorShortName = TRIM(CSTR(Value (1,200))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,201))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,202))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,203))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,204))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,205))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,206))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,207))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,208))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,209))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,210))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,211))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,212))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,213))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,214))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,215))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,216))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,217))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,218))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,219))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,220))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,221))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,222))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,223))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,224))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,225))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,226))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,227))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,228))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,229))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,230))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,231))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,232))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,233))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,234))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,235))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,236))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,237))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,238))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,239))) 'WinLine Mandantenkürzel (individual Feld)
MandatorShortName = TRIM(CSTR(Value (1,240))) 'WinLine Mandantenkürzel (individual Feld)
'Costumer variables - dont forget to add the replace function in the lower preparing part.
'VarName = mesoField 'Description
'#-----------------------------------------------------------------------------------------------------#
'########################################### preparing part ############################################
'#-----------------------------------------------------------------------------------------------------#
'Retrive Document Type (0 = Vorschau).
IF (DocType = 0) THEN
'Nothing will happen, its just a Preview ;-)
'Retrive Document Type (1 = Angebot/Anfrage). Depending on it, the Targetpath and Targetfilename.
ELSEIF (DocType = 1) THEN)
'If document is for a debtor.
IF (PostingType = 1) THEN
'If ExportPath has content
IF NOT (IsEmpty(DocAANGExportPath) Or IsNull(DocAANGExportPath) Or DocAANGExportPath = "") THEN
DocTargetPath = DocAANGExportPath
'If ExportPath has no content, fallback on the general WinLine network path.
ELSE
DocTargetPath = "%NETWORK%"
END IF
'If Convention has content.
IF NOT (IsEmpty(DocAANGConvention) Or IsNull(DocAANGConvention) Or DocAANGConvention = "") THEN
DocTargetFileName = DocAANGConvention
'If Convention AND ExportPath had both no content.
ELSEIF (DocTargetPath = "%NETWORK%") THEN
DocTargetFileName = Nothing
'If ExportPath has content, but Convention hasnt.
ELSE
MSGBOX("Ungültige Export Dateinamens Einstellung für Ausgangsangebote. FailSafe ist AANG_" & DocAccountNumber & "_" & Timestamp & ".pdf" & "!")
DocTargetFileName = "AANG_" & DocAccountNumber & Timestamp
END IF
'If document is for a creditor.
ELSEIF (PostingType = 2) THEN
'If ExportPath has content
IF NOT (IsEmpty(DocAANFExportPath) Or IsNull(DocAANFExportPath) Or DocAANFExportPath = "") THEN
DocTargetPath = DocAANFExportPath
'If ExportPath has no content, fallback on the general WinLine network path.
ELSE
DocTargetPath = "%NETWORK%"
END IF
'If Convention has content.
IF NOT (IsEmpty(DocAANFConvention) Or IsNull(DocAANFConvention) Or DocAANFConvention = "") THEN
DocTargetFileName = DocAANFConvention
'If Convention AND ExportPath had both no content.
ELSEIF (DocTargetPath = "%NETWORK%") THEN
DocTargetFileName = Nothing
'If ExportPath has content, but Convention hasnt.
ELSE
MSGBOX("Ungültige Export Dateinamens Einstellung für Ausgangsanfragen. FailSafe ist AANF_" & DocAccountNumber & "_" & Timestamp & ".pdf" & "!")
DocTargetFileName = "AANF_" & DocAccountNumber & Timestamp
END IF
'If document is not for a debtor or creditor.
ELSE
MSGBOX("Undefinierte Export Einstellung! Abbruch des Exports.")
END IF
'########## working on it'#########
'Retrive Document Type (10 = StornoAngebot/Anfrage). Depending on it, the Targetpath and Targetfilename.
ELSEIF (DocType = 1) THEN)
'If document is for a debtor.
IF (PostingType = 1) THEN
'If ExportPath has content
IF NOT (IsEmpty(DocAANGExportPath) Or IsNull(DocAANGExportPath) Or DocAANGExportPath = "") THEN
DocTargetPath = DocAANGExportPath
'If ExportPath has no content, fallback on the general WinLine network path.
ELSE
DocTargetPath = "%NETWORK%"
END IF
'If Convention has content.
IF NOT (IsEmpty(DocAANGConvention) Or IsNull(DocAANGConvention) Or DocAANGConvention = "") THEN
DocTargetFileName = DocAANGConvention
'If Convention AND ExportPath had both no content.
ELSEIF (DocTargetPath = "%NETWORK%") THEN
DocTargetFileName = Nothing
'If ExportPath has content, but Convention hasnt.
ELSE
MSGBOX("Ungültige Export Dateinamens Einstellung für Ausgangsangebote. FailSafe ist AANG_" & DocAccountNumber & "_" & Timestamp & ".pdf" & "!")
DocTargetFileName = "AANG_" & DocAccountNumber & Timestamp
END IF
'If document is for a creditor.
ELSEIF (PostingType = 2) THEN
'If ExportPath has content
IF NOT (IsEmpty(DocAANFExportPath) Or IsNull(DocAANFExportPath) Or DocAANFExportPath = "") THEN
DocTargetPath = DocAANFExportPath
'If ExportPath has no content, fallback on the general WinLine network path.
ELSE
DocTargetPath = "%NETWORK%"
END IF
'If Convention has content.
IF NOT (IsEmpty(DocAANFConvention) Or IsNull(DocAANFConvention) Or DocAANFConvention = "") THEN
DocTargetFileName = DocAANFConvention
'If Convention AND ExportPath had both no content.
ELSEIF (DocTargetPath = "%NETWORK%") THEN
DocTargetFileName = Nothing
'If ExportPath has content, but Convention hasnt.
ELSE
MSGBOX("Ungültige Export Dateinamens Einstellung für Ausgangsanfragen. FailSafe ist AANF_" & DocAccountNumber & "_" & Timestamp & ".pdf" & "!")
DocTargetFileName = "AANF_" & DocAccountNumber & Timestamp
END IF
'If document is not for a debtor or creditor.
ELSE
MSGBOX("Undefinierte Export Einstellung! Abbruch des Exports.")
END IF
'########## working on it
'Retrive Document Type (2 = Auftrag/Bestellung). Depending on it, the Targetpath and Targetfilename.
ELSEIF (DocType = 2) THEN
'If document is for a debtor.
IF (PostingType = 1) THEN
'If ExportPath has content
IF NOT (IsEmpty(DocAABExportPath) Or IsNull(DocAABExportPath) Or DocAABExportPath = "") THEN
DocTargetPath = DocAABExportPath
'If ExportPath has no content, try to exit. But exit wont work, so fallback on the general WinLine network path.
ELSE
DocTargetPath = "%NETWORK%"
END IF
'If Convention has content.
IF NOT (IsEmpty(DocAABConvention) Or IsNull(DocAABConvention) Or DocAABConvention = "") THEN
DocTargetFileName = DocAABConvention
'If Convention AND ExportPath had both no content.
ELSEIF (DocTargetPath = "%NETWORK%") THEN
DocTargetFileName = Nothing
'If ExportPath has content, but Convention hasnt.
ELSE
MSGBOX("Ungültige Export Dateinamens Einstellung für Ausgangsauftragsbestätgrechnungen. FailSafe ist AAB_" & DocAccountNumber & "_" & Timestamp & ".pdf" & "!")
DocTargetFileName = "AAB_" & DocAccountNumber & Timestamp
END IF
'If document is for a creditor.
ELSEIF (PostingType = 2) THEN
'If ExportPath has content
IF NOT (IsEmpty(DocABEExportPath) Or IsNull(DocABEExportPath) Or DocABEExportPath = "") THEN
DocTargetPath = DocABEExportPath
'If ExportPath has no content, fallback on the general WinLine network path.
ELSE
DocTargetPath = "%NETWORK%"
END IF
'If Convention has content.
IF NOT (IsEmpty(DocABEConvention) Or IsNull(DocABEConvention) Or DocABEConvention = "") THEN
DocTargetFileName = DocABEConvention
'If Convention AND ExportPath had both no content.
ELSEIF (DocTargetPath = "%NETWORK%") THEN
DocTargetFileName = Nothing
'If ExportPath has content, but Convention hasnt.
ELSE
MSGBOX("Ungültige Export Dateinamens Einstellung für Ausgangsbestellungen. FailSafe ist ABE_" & DocAccountNumber & "_" & Timestamp & ".pdf" & "!")
DocTargetFileName = "ABE_" & DocAccountNumber & Timestamp
END IF
'If document is not for a debtor or creditor.
ELSE
MSGBOX("Undefinierte Export Einstellung! Abbruch des Exports.")
END IF
'Retrive Document Type (3 = Lieferschein / -3 = Teillieferschein). Depending on it, the Targetpath and Targetfilename.
ELSEIF (DocType = 3 OR DocType = -3) THEN
'If document is for a debtor.
IF (PostingType = 1) THEN
'If ExportPath has content
IF NOT (IsEmpty(DocALSExportPath) Or IsNull(DocALSExportPath) Or DocALSExportPath = "") THEN
DocTargetPath = DocALSExportPath
'If ExportPath has no content, try to exit. But exit wont work, so fallback on the general WinLine network path.
ELSE
DocTargetPath = "%NETWORK%"
END IF
'If Convention has content.
IF NOT (IsEmpty(DocALSConvention) Or IsNull(DocALSConvention) Or DocALSConvention = "") THEN
DocTargetFileName = DocALSConvention
'If Convention AND ExportPath had both no content.
ELSEIF (DocTargetPath = "%NETWORK%") THEN
DocTargetFileName = Nothing
'If ExportPath has content, but Convention hasnt.
ELSE
MSGBOX("Ungültige Export Dateinamens Einstellung für Ausgangslieferscheine. FailSafe ist ALS_" & DocAccountNumber & "_" & Timestamp & ".pdf" & "!")
DocTargetFileName = "ALS_" & DocAccountNumber & Timestamp
END IF
'If document is for a creditor.
ELSEIF (PostingType = 2) THEN
'########################################### Currently not implemented ###########################################
'If document is not for a debtor or creditor.
ELSE
MSGBOX("Undefinierte Export Einstellung! Abbruch des Exports.")
END IF
'Retrive Document Type (4 = Rechnung). Depending on it, the Targetpath and Targetfilename.
ELSEIF (DocType = 4) THEN
'If document is for a debtor.
IF (PostingType = 1) THEN
IF (LEFT(Amount,1) = "-") THEN
'If ExportPath has content
IF NOT (IsEmpty(DocAGUExportPath) Or IsNull(DocAGUExportPath) Or DocAGUExportPath = "") THEN
DocTargetPath = DocAGUExportPath
'If ExportPath has no content, try to exit. But exit wont work, so fallback on the general WinLine network path.
ELSE
DocTargetPath = "%NETWORK%"
END IF
'If Convention has content.
IF NOT (IsEmpty(DocAGUConvention) Or IsNull(DocAGUConvention) Or DocAGUConvention = "") THEN
DocTargetFileName = DocAGUConvention
'If Convention AND ExportPath had both no content.
ELSEIF (DocTargetPath = "%NETWORK%") THEN
DocTargetFileName = Nothing
'If ExportPath has content, but Convention hasnt.
ELSE
MSGBOX("Ungültige Export Dateinamens Einstellung für Ausgangsgutschriften. FailSafe ist AGU_" & DocAccountNumber & "_" & Timestamp & ".pdf" & "!")
DocTargetFileName = "AGU_" & DocAccountNumber & Timestamp
END IF
ELSE
'If ExportPath has content
IF NOT (IsEmpty(DocAREExportPath) Or IsNull(DocAREExportPath) Or DocAREExportPath = "") THEN
DocTargetPath = DocAREExportPath
'If ExportPath has no content, try to exit. But exit wont work, so fallback on the general WinLine network path.
ELSE
DocTargetPath = "%NETWORK%"
END IF
'If Convention has content.
IF NOT (IsEmpty(DocAREConvention) Or IsNull(DocAREConvention) Or DocAREConvention = "") THEN
DocTargetFileName = DocAREConvention
'If Convention AND ExportPath had both no content.
ELSEIF (DocTargetPath = "%NETWORK%") THEN
DocTargetFileName = Nothing
'If ExportPath has content, but Convention hasnt.
ELSE
MSGBOX("Ungültige Export Dateinamens Einstellung für Ausgangsrechnungen. FailSafe ist ARE_" & DocAccountNumber & "_" & Timestamp & ".pdf" & "!")
DocTargetFileName = "ARE_" & DocAccountNumber & Timestamp
END IF
END IF
'If document is for a creditor.
ELSEIF (PostingType = 2) THEN
'########################################### Currently not implemented ###########################################
'If document is not for a debtor or creditor.
ELSE
MSGBOX("Undefinierte Export Einstellung! Abbruch des Exports.")
END IF
'Retrive Document Type (14 = StornoRechnung). Depending on it, the Targetpath and Targetfilename.
ELSEIF (DocType = 14) THEN
'If DocType was unknown.
ELSE
MSGBOX("Undefinierte Belegstufe (" & DocType & ")! Abbruch des Exports.")
END IF
'Replace PlaceHolder in DocTargetPath from Configuration, including invalid Characters.
IF (DocTargetPath <> "") THEN
DocTargetPath = Replace(DocTargetPath,"%Mandantenkürzel%",MandatorShortName)
DocTargetPath = Replace(DocTargetPath,"%Jahr%",(Year(date)))
DocTargetPath = Replace(DocTargetPath,"%Monat%",(month(date)))
DocTargetPath = Replace(DocTargetPath,"%Monatsname%",MonthName((month(date))))
DocTargetPath = Replace(DocTargetPath,"%Tag%",(day(date)))
DocTargetPath = Replace(DocTargetPath,"%KontoNr%",DocAccountNumber)
DocTargetPath = Replace(DocTargetPath,"%Laufnummer%",RecordNumber)
DocTargetPath = Replace(Replace(Replace(Replace(Replace(Replace(DocTargetPath,"/",ReplaceSpecialChar),"*",ReplaceSpecialChar),"?",ReplaceSpecialChar),"<",ReplaceSpecialChar),">",ReplaceSpecialChar),"|",ReplaceSpecialChar)
END IF
'Replace PlaceHolder in DocTargetFileName from Configuration, including invalid Characters.
IF (DocTargetFileName <> "") THEN
DocTargetFileName = Replace(DocTargetFileName,"%Mandantenkürzel%",MandatorShortName)
DocTargetFileName = Replace(DocTargetFileName,"%AngebotsNr%",DocAANGNumber)
DocTargetFileName = Replace(DocTargetFileName,"%AuftragsNr%",DocAABNumber)
DocTargetFileName = Replace(DocTargetFileName,"%LieferscheinNr%",DocALSNumber)
DocTargetFileName = Replace(DocTargetFileName,"%RechnungsNr%",DocARENumber)
DocTargetFileName = Replace(DocTargetFileName,"%AnfragenNr%",DocAANFNumber)
DocTargetFileName = Replace(DocTargetFileName,"%BestellNr%",DocABENumber)
DocTargetFileName = Replace(DocTargetFileName,"%Jahr%",(Year(date)))
DocTargetFileName = Replace(DocTargetFileName,"%Monat%",(month(date)))
DocTargetFileName = Replace(DocTargetFileName,"%Monatsname%",MonthName((month(date))))
DocTargetFileName = Replace(DocTargetFileName,"%Tag%",(day(date)))
DocTargetFileName = Replace(DocTargetFileName,"%KontoNr%",DocAccountNumber)
DocTargetFileName = Replace(DocTargetFileName,"%Laufnummer%",RecordNumber)
DocTargetFileName = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(DocTargetFileName,"\",ReplaceSpecialChar),"/",ReplaceSpecialChar),":",ReplaceSpecialChar),"*",ReplaceSpecialChar),"?",ReplaceSpecialChar),"<",ReplaceSpecialChar),">",ReplaceSpecialChar),"|",ReplaceSpecialChar)
END IF
'#-----------------------------------------------------------------------------------------------------#
'############################################# main part ###############################################
'#-----------------------------------------------------------------------------------------------------#
'Check if all necessary export parameters are set.
IF ((DocTargetPath <> "") AND (DocTargetFileName <> "") AND (DocExtension <> "")) THEN
'Check if destination folder / folder strukture exists. If not, try to create.
IF NOT FileSystemObject.FolderExists(DocTargetPath) THEN
strDir = FileSystemObject.GetAbsolutePathName(DocTargetPath)
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 DocTargetPath exists, export file - including version tagging.
IF (FileSystemObject.FolderExists(DocTargetPath)) THEN
FullPath = DocTargetPath & "\" & DocTargetFileName & DocExtension
IF (FileSystemObject.FileExists(FullPath)) THEN
DO
DocVersion = DocVersion + 1
FullPath = DocTargetPath & "\" & DocTargetFileName & DocVersionSeparator & DocVersion & DocExtension
LOOP UNTIL (FileSystemObject.FileExists(FullPath) = False)
END IF
ExportOutput FullPath, 5, 0
'Optional check if file was exported successfully.
IF (DocExportCheck = "true") THEN
CheckExportScriptPath = FileSystemObject.FolderExists(Shell.ExpandEnvironmentStrings("%TEMP%") & "\" & "Digital_Data")
CheckExportScript = "CheckExport-" & DocTargetFileName & ((year(DateTime)*100 + month(DateTime))*100 + day(DateTime))*10000 + hour(DateTime)*100 + minute(DateTime) & ".vbs"
IF NOT (CheckExportScriptPath) THEN
FileSystemObject.CreateFolder(CheckExportScriptPath)
END IF
IF (FileSystemObject.FolderExists(CheckExportScriptPath)) THEN
ELSE
END IF
END IF
ELSE
MSGBOX("ACHTUNG: Zielpfad für Export konnte nicht erstellt werden! Export wird abgebrochen.")
END IF
ELSE
'Missing Value in DocTargetPath, DocTargetFileName or DocExtension
WScript.Quit(1)
END IF
'#-----------------------------------------------------------------------------------------------------#
'########################################### finishing part ############################################
'#-----------------------------------------------------------------------------------------------------#
FileSystemObject = Nothing
Shell = Nothing
DateTime = Nothing
SplitChar = Nothing
ReplaceSpecialChar = Nothing
DocExtension = Nothing
DocExportCheck = Nothing
DocExportCheckTry = Nothing
DocExportCheckMaxTrys = Nothing
DocType = Nothing
DocVersion = Nothing
DocVersionSeparator = Nothing
MandatorShortName = Nothing
DocAccountNumber = Nothing
DocAANGExportPath = Nothing
DocAABExportPath = Nothing
DocALSExportPath = Nothing
DocAREExportPath = Nothing
DocAANFExportPath = Nothing
DocABExportPath = Nothing
DocAANGConvention = Nothing
DocAABConvention = Nothing
DocALSConvention = Nothing
DocAREConvention = Nothing
DocAANFConvention = Nothing
DocABEConvention = Nothing
DocAANGNumber = Nothing
DocAABNumber = Nothing
DocALSNumber = Nothing
DocARENumber = Nothing
DocAANFNumber = Nothing
DocABENumber = Nothing
DocTargetPath = Nothing
DocTargetFileName = Nothing
FullPath = Nothing
Result = ""

View File

@ -0,0 +1,509 @@
' VB Script Document
'
' Export Script for WinLine documents.
' Configuration has to be done in the additional fields in the "WinLine Mandantenstamm"
'
' Digital Data
' Ludwig-Rinn-Straße 16
' 35452 Heuchelheim
' Tel.: 0641 / 202360
' E-Mail: info(at)didalog.de
'
' Version Number: 1.0.0.0
' Version Date: 23.04.2019
On Error Resume Next
'#-----------------------------------------------------------------------------------------------------#
'############################################ set variables ############################################
'#-----------------------------------------------------------------------------------------------------#
DIM DateTime, SplitChar, ReplaceSpecialChar, DocExtension, DocVersion, DocVersionSeparator, DocType, MandatorShortName, DocAccountNumber, DocAANGExportPath, DocAABExportPath, DocALSExportPath, DocAREExportPath
DIM FileSystemObject, Shell, DocAANGConvention, DocAABConvention, DocALSConvention, DocAREConvention, DocAANGNumber, DocAABNumber, DocALSNumber, DocARENumber, DocTargetPath, DocTargetFileName, FullPath
SET FileSystemObject = CreateObject("Scripting.FileSystemObject")
SET Shell = CreateObject("WScript.Shell")
'Standard / default variables.
DateTime = now
SplitChar = "|"
ReplaceSpecialChar = " "
DocExtension = ".pdf"
DocExportCheck = "true"
DocExportCheckTry = 0
DocExportCheckMaxTrys = 10
DocVersion = 1
DocVersionSeparator = "~"
DocType = Value (25,139) 'WinLine Belegstufe
RecordNumber = Value (25,22) 'WinLine Laufnummer
PostingType = Value (357,6) 'WinLine Buchungsart (Debitorisch = 1 / Kreditorisch = 2)
MandatorShortName = TRIM(CSTR(Value (1,200))) 'WinLine Mandantenkürzel (individual Feld)
DocAccountNumber = TRIM(CSTR(Value (0,30))) 'WinLine Kontonummer (Debitor / Kreditor)
DocAANGNumber = TRIM(CSTR(Value (0,34))) 'WinLine Angebotsnummer
DocAABNumber = TRIM(CSTR(Value (0,35))) 'WinLine Auftragsnummer
DocALSNumber = TRIM(CSTR(Value (0,36))) 'WinLine Lieferscheinnummer
DocARENumber = TRIM(CSTR(Value (0,37))) 'WinLine Rechnungsnummer
DocAANFNumber = TRIM(CSTR(Value (0,34))) 'WinLine Anfragennummer
DocABENumber = TRIM(CSTR(Value (0,35))) 'WinLine Bestellnummer
DocAANGExportPath = TRIM(CSTR(Split(Value (1,201),SplitChar)(0))) 'WinLine Exportpfad für Angebote (individual Feld)
DocAABExportPath = TRIM(CSTR(Split(Value (1,202),SplitChar)(0))) 'WinLine Exportpfad für Aufträge (individual Feld)
DocALSExportPath = TRIM(CSTR(Split(Value (1,203),SplitChar)(0))) 'WinLine Exportpfad für Lieferscheine (individual Feld)
DocAREExportPath = TRIM(CSTR(Split(Value (1,204),SplitChar)(0))) 'WinLine Exportpfad für Rechnungen (individual Feld)
DocAANFExportPath = TRIM(CSTR(Split(Value (1,205),SplitChar)(0))) 'WinLine Exportpfad für Anfragen (individual Feld)
DocABEExportPath = TRIM(CSTR(Split(Value (1,206),SplitChar)(0))) 'WinLine Exportpfad für Bestellungen (individual Feld)
DocAANGConvention = TRIM(CSTR(Split(Value (1,201),SplitChar)(1))) 'WinLine Benennungsschema für Angebote (individual Feld)
DocAABConvention = TRIM(CSTR(Split(Value (1,202),SplitChar)(1))) 'WinLine Benennungsschema für Aufträge (individual Feld)
DocALSConvention = TRIM(CSTR(Split(Value (1,203),SplitChar)(1))) 'WinLine Benennungsschema für Lieferscheine (individual Feld)
DocAREConvention = TRIM(CSTR(Split(Value (1,204),SplitChar)(1))) 'WinLine Benennungsschema für Rechnungen (individual Feld)
DocAANFConvention = TRIM(CSTR(Split(Value (1,205),SplitChar)(1))) 'WinLine Benennungsschema für Anfragen (individual Feld)
DocABEConvention = TRIM(CSTR(Split(Value (1,206),SplitChar)(1))) 'WinLine Benennungsschema für Bestellungen (individual Feld)
'Costumer variables - dont forget to add the replace function in the lower preparing part.
'VarName = mesoField 'Description
'#-----------------------------------------------------------------------------------------------------#
'########################################### preparing part ############################################
'#-----------------------------------------------------------------------------------------------------#
'Retrive Document Type (1 = Angebot/Anfrage). Depending on it, the Targetpath and Targetfilename.
IF (DocType = 1) THEN
'If document is for a debtor.
IF (PostingType = 1) THEN
'If ExportPath has content
IF NOT (IsEmpty(DocAANGExportPath) Or IsNull(DocAANGExportPath) Or DocAANGExportPath = "") THEN
DocTargetPath = DocAANGExportPath
'If ExportPath has no content, fallback on the general WinLine network path.
ELSE
DocTargetPath = "%NETWORK%"
END IF
'If Convention has content.
IF NOT (IsEmpty(DocAANGConvention) Or IsNull(DocAANGConvention) Or DocAANGConvention = "") THEN
DocTargetFileName = DocAANGConvention
'If Convention AND ExportPath had both no content.
ELSEIF (DocTargetPath = "%NETWORK%") THEN
DocTargetFileName = Nothing
'If ExportPath has content, but Convention hasnt.
ELSE
MSGBOX("Ungültige Export Dateinamens Einstellung für Ausgangsangebote. FailSafe ist AANG_" & DocAccountNumber & ((year(DateTime)*100 + month(DateTime))*100 + day(DateTime))*10000 + hour(DateTime)*100 + minute(DateTime) & ".pdf" & "!")
DocTargetFileName = "AANG_" & DocAccountNumber & ((year(DateTime)*100 + month(DateTime))*100 + day(DateTime))*10000 + hour(DateTime)*100 + minute(DateTime)
END IF
'If document is for a creditor.
ELSEIF (PostingType = 2) THEN
'If ExportPath has content
IF NOT (IsEmpty(DocAANFExportPath) Or IsNull(DocAANFExportPath) Or DocAANFExportPath = "") THEN
DocTargetPath = DocAANFExportPath
'If ExportPath has no content, fallback on the general WinLine network path.
ELSE
DocTargetPath = "%NETWORK%"
END IF
'If Convention has content.
IF NOT (IsEmpty(DocAANFConvention) Or IsNull(DocAANFConvention) Or DocAANFConvention = "") THEN
DocTargetFileName = DocAANFConvention
'If Convention AND ExportPath had both no content.
ELSEIF (DocTargetPath = "%NETWORK%") THEN
DocTargetFileName = Nothing
'If ExportPath has content, but Convention hasnt.
ELSE
MSGBOX("Ungültige Export Dateinamens Einstellung für Ausgangsanfragen. FailSafe ist AANF_" & DocAccountNumber & ((year(DateTime)*100 + month(DateTime))*100 + day(DateTime))*10000 + hour(DateTime)*100 + minute(DateTime) & ".pdf" & "!")
DocTargetFileName = "AANF_" & DocAccountNumber & ((year(DateTime)*100 + month(DateTime))*100 + day(DateTime))*10000 + hour(DateTime)*100 + minute(DateTime)
END IF
'If document is not for a debtor or creditor.
ELSE
MSGBOX("Undefinierte Export Einstellung! Abbruch des Exports.")
END IF
'Retrive Document Type (2 = Auftrag/Bestellung). Depending on it, the Targetpath and Targetfilename.
ELSEIF (DocType = 2) THEN
'If document is for a debtor.
IF (PostingType = 1) THEN
'If ExportPath has content
IF NOT (IsEmpty(DocAABExportPath) Or IsNull(DocAABExportPath) Or DocAABExportPath = "") THEN
DocTargetPath = DocAABExportPath
'If ExportPath has no content, try to exit. But exit wont work, so fallback on the general WinLine network path.
ELSE
DocTargetPath = "%NETWORK%"
END IF
'If Convention has content.
IF NOT (IsEmpty(DocAABConvention) Or IsNull(DocAABConvention) Or DocAABConvention = "") THEN
DocTargetFileName = DocAABConvention
'If Convention AND ExportPath had both no content.
ELSEIF (DocTargetPath = "%NETWORK%") THEN
DocTargetFileName = Nothing
'If ExportPath has content, but Convention hasnt.
ELSE
MSGBOX("Ungültige Export Dateinamens Einstellung für Ausgangsauftragsbestätgrechnungen. FailSafe ist AAB_" & DocAccountNumber & ((year(DateTime)*100 + month(DateTime))*100 + day(DateTime))*10000 + hour(DateTime)*100 + minute(DateTime) & ".pdf" & "!")
DocTargetFileName = "AAB_" & DocAccountNumber & ((year(DateTime)*100 + month(DateTime))*100 + day(DateTime))*10000 + hour(DateTime)*100 + minute(DateTime)
END IF
'If document is for a creditor.
ELSEIF (PostingType = 2) THEN
'If ExportPath has content
IF NOT (IsEmpty(DocABEExportPath) Or IsNull(DocABEExportPath) Or DocABEExportPath = "") THEN
DocTargetPath = DocABEExportPath
'If ExportPath has no content, fallback on the general WinLine network path.
ELSE
DocTargetPath = "%NETWORK%"
END IF
'If Convention has content.
IF NOT (IsEmpty(DocABEConvention) Or IsNull(DocABEConvention) Or DocABEConvention = "") THEN
DocTargetFileName = DocABEConvention
'If Convention AND ExportPath had both no content.
ELSEIF (DocTargetPath = "%NETWORK%") THEN
DocTargetFileName = Nothing
'If ExportPath has content, but Convention hasnt.
ELSE
MSGBOX("Ungültige Export Dateinamens Einstellung für Ausgangsbestellungen. FailSafe ist ABE_" & DocAccountNumber & ((year(DateTime)*100 + month(DateTime))*100 + day(DateTime))*10000 + hour(DateTime)*100 + minute(DateTime) & ".pdf" & "!")
DocTargetFileName = "ABE_" & DocAccountNumber & ((year(DateTime)*100 + month(DateTime))*100 + day(DateTime))*10000 + hour(DateTime)*100 + minute(DateTime)
END IF
'If document is not for a debtor or creditor.
ELSE
MSGBOX("Undefinierte Export Einstellung! Abbruch des Exports.")
END IF
'Retrive Document Type (3 = Lieferschein). Depending on it, the Targetpath and Targetfilename.
ELSEIF (DocType = 3) THEN
'If document is for a debtor.
IF (PostingType = 1) THEN
'If ExportPath has content
IF NOT (IsEmpty(DocALSExportPath) Or IsNull(DocALSExportPath) Or DocALSExportPath = "") THEN
DocTargetPath = DocALSExportPath
'If ExportPath has no content, try to exit. But exit wont work, so fallback on the general WinLine network path.
ELSE
DocTargetPath = "%NETWORK%"
END IF
'If Convention has content.
IF NOT (IsEmpty(DocALSConvention) Or IsNull(DocALSConvention) Or DocALSConvention = "") THEN
DocTargetFileName = DocALSConvention
'If Convention AND ExportPath had both no content.
ELSEIF (DocTargetPath = "%NETWORK%") THEN
DocTargetFileName = Nothing
'If ExportPath has content, but Convention hasnt.
ELSE
MSGBOX("Ungültige Export Dateinamens Einstellung für Ausgangslieferscheine. FailSafe ist ALS_" & DocAccountNumber & ((year(DateTime)*100 + month(DateTime))*100 + day(DateTime))*10000 + hour(DateTime)*100 + minute(DateTime) & ".pdf" & "!")
DocTargetFileName = "ALS_" & DocAccountNumber & ((year(DateTime)*100 + month(DateTime))*100 + day(DateTime))*10000 + hour(DateTime)*100 + minute(DateTime)
END IF
'If document is for a creditor.
ELSEIF (PostingType = 2) THEN
'########################################### Currently not implemented ###########################################
'If document is not for a debtor or creditor.
ELSE
MSGBOX("Undefinierte Export Einstellung! Abbruch des Exports.")
END IF
'Retrive Document Type (4 = Rechnung). Depending on it, the Targetpath and Targetfilename.
ELSEIF (DocType = 4) THEN
'If document is for a debtor.
IF (PostingType = 1) THEN
'If ExportPath has content
IF NOT (IsEmpty(DocAREExportPath) Or IsNull(DocAREExportPath) Or DocAREExportPath = "") THEN
DocTargetPath = DocAREExportPath
'If ExportPath has no content, try to exit. But exit wont work, so fallback on the general WinLine network path.
ELSE
DocTargetPath = "%NETWORK%"
END IF
'If Convention has content.
IF NOT (IsEmpty(DocAREConvention) Or IsNull(DocAREConvention) Or DocAREConvention = "") THEN
DocTargetFileName = DocAREConvention
'If Convention AND ExportPath had both no content.
ELSEIF (DocTargetPath = "%NETWORK%") THEN
DocTargetFileName = Nothing
'If ExportPath has content, but Convention hasnt.
ELSE
MSGBOX("Ungültige Export Dateinamens Einstellung für Ausgangsrechnungen. FailSafe ist ARE_" & DocAccountNumber & ((year(DateTime)*100 + month(DateTime))*100 + day(DateTime))*10000 + hour(DateTime)*100 + minute(DateTime) & ".pdf" & "!")
DocTargetFileName = "ARE_" & DocAccountNumber & ((year(DateTime)*100 + month(DateTime))*100 + day(DateTime))*10000 + hour(DateTime)*100 + minute(DateTime)
END IF
'If document is for a creditor.
ELSEIF (PostingType = 2) THEN
'########################################### Currently not implemented ###########################################
'If document is not for a debtor or creditor.
ELSE
MSGBOX("Undefinierte Export Einstellung! Abbruch des Exports.")
END IF
'If DocType was unknown.
ELSE
MSGBOX("Undefinierte Belegstufe! Abbruch des Exports.")
END IF
'Replace PlaceHolder in DocTargetPath from Configuration, including invalid Characters.
IF (DocTargetPath <> "") THEN
DocTargetPath = Replace(DocTargetPath,"%Mandantenkürzel%",MandatorShortName)
DocTargetPath = Replace(DocTargetPath,"%Jahr%",(Year(date)))
DocTargetPath = Replace(DocTargetPath,"%Monat%",(month(date)))
DocTargetPath = Replace(DocTargetPath,"%Monatsname%",MonthName((month(date))))
DocTargetPath = Replace(DocTargetPath,"%Tag%",(day(date)))
DocTargetPath = Replace(DocTargetPath,"%KontoNr%",DocAccountNumber)
DocTargetPath = Replace(DocTargetPath,"%Laufnummer%",RecordNumber)
DocTargetPath = Replace(Replace(Replace(Replace(Replace(Replace(DocTargetPath,"/",ReplaceSpecialChar),"*",ReplaceSpecialChar),"?",ReplaceSpecialChar),"<",ReplaceSpecialChar),">",ReplaceSpecialChar),"|",ReplaceSpecialChar)
END IF
'Replace PlaceHolder in DocTargetFileName from Configuration, including invalid Characters.
IF (DocTargetFileName <> "") THEN
DocTargetFileName = Replace(DocTargetFileName,"%Mandantenkürzel%",MandatorShortName)
DocTargetFileName = Replace(DocTargetFileName,"%AngebotsNr%",DocAANGNumber)
DocTargetFileName = Replace(DocTargetFileName,"%AuftragsNr%",DocAABNumber)
DocTargetFileName = Replace(DocTargetFileName,"%LieferscheinNr%",DocALSNumber)
DocTargetFileName = Replace(DocTargetFileName,"%RechnungsNr%",DocARENumber)
DocTargetFileName = Replace(DocTargetFileName,"%AnfragenNr%",DocAANFNumber)
DocTargetFileName = Replace(DocTargetFileName,"%BestellNr%",DocABENumber)
DocTargetFileName = Replace(DocTargetFileName,"%Jahr%",(Year(date)))
DocTargetFileName = Replace(DocTargetFileName,"%Monat%",(month(date)))
DocTargetFileName = Replace(DocTargetFileName,"%Monatsname%",MonthName((month(date))))
DocTargetFileName = Replace(DocTargetFileName,"%Tag%",(day(date)))
DocTargetFileName = Replace(DocTargetFileName,"%KontoNr%",DocAccountNumber)
DocTargetFileName = Replace(DocTargetFileName,"%Laufnummer%",RecordNumber)
DocTargetFileName = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(DocTargetFileName,"\",ReplaceSpecialChar),"/",ReplaceSpecialChar),":",ReplaceSpecialChar),"*",ReplaceSpecialChar),"?",ReplaceSpecialChar),"<",ReplaceSpecialChar),">",ReplaceSpecialChar),"|",ReplaceSpecialChar)
END IF
'#-----------------------------------------------------------------------------------------------------#
'############################################# main part ###############################################
'#-----------------------------------------------------------------------------------------------------#
'Check if all necessary export parameters are set.
IF ((DocTargetPath <> "") AND (DocTargetFileName <> "") AND (DocExtension <> "")) THEN
'Check if destination folder / folder strukture exists. If not, try to create.
IF NOT FileSystemObject.FolderExists(DocTargetPath) THEN
strDir = FileSystemObject.GetAbsolutePathName(DocTargetPath)
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 DocTargetPath exists, export file - including version tagging.
IF (FileSystemObject.FolderExists(DocTargetPath)) THEN
FullPath = DocTargetPath & "\" & DocTargetFileName & DocExtension
IF (FileSystemObject.FileExists(FullPath)) THEN
DO
DocVersion = DocVersion + 1
FullPath = DocTargetPath & "\" & DocTargetFileName & DocVersionSeparator & DocVersion & DocExtension
LOOP UNTIL (FileSystemObject.FileExists(FullPath) = False)
END IF
ExportOutput FullPath, 5, 0
'Optional check if file was exported successfully.
IF (DocExportCheck = "true") THEN
CheckExportScriptPath = FileSystemObject.FolderExists(Shell.ExpandEnvironmentStrings("%TEMP%") & "\" & "Digital_Data")
CheckExportScript = "CheckExport-" & DocTargetFileName & ((year(DateTime)*100 + month(DateTime))*100 + day(DateTime))*10000 + hour(DateTime)*100 + minute(DateTime) & ".vbs"
IF NOT (CheckExportScriptPath) THEN
FileSystemObject.CreateFolder(CheckExportScriptPath)
END IF
IF (FileSystemObject.FolderExists(CheckExportScriptPath)) THEN
CheckExportFile = CheckExportScriptPath & "\" & CheckExportScript
Set CheckExportObject = FileSystemObject.CreateTextFile(CheckExportFile,True)
CheckExportObject.Write "DIM FileSystemObject, Fullpath, DocExportCheckTry, DocExportCheckMaxTrys" & vbCrLf
CheckExportObject.Write "SET FileSystemObject = CreateObject(\"Scripting.FileSystemObject\")" & vbCrLf
CheckExportObject.Write "" & vbCrLf
CheckExportObject.Write "FullPath = Wscript.Arguments(0)" & vbCrLf
CheckExportObject.Write "DocExportCheckTry = Wscript.Arguments(1)" & vbCrLf
CheckExportObject.Write "DocExportCheckMaxTrys = Wscript.Arguments(2)" & vbCrLf
CheckExportObject.Write "" & vbCrLf
CheckExportObject.Write "DO" & vbCrLf
CheckExportObject.Write "" & vbCrLf
CheckExportObject.Write "DocExportCheckTry = DocExportCheckTry + 1" & vbCrLf
CheckExportObject.Write "WScript.Sleep 3000 'Wait 3 Seconds" & vbCrLf
CheckExportObject.Write "" & vbCrLf
CheckExportObject.Write "LOOP UNTIL ((FileSystemObject.FileExists(FullPath) = True) OR ((DocExportCheckTry >= DocExportCheckMaxTrys) = True))" & vbCrLf
CheckExportObject.Write "" & vbCrLf
CheckExportObject.Write "IF NOT (FileSystemObject.FileExists(FullPath)) THEN" & vbCrLf
CheckExportObject.Write "" & vbCrLf
CheckExportObject.Write 'MSGBOX("ACHTUNG: Der Export ist fehlgeschlagen! Bitte wenden Sie sich an Ihren Administrator!")' & vbCrLf
CheckExportObject.Write "" & vbCrLf
CheckExportObject.Write "END IF" & vbCrLf
CheckExportObject.Write "" & vbCrLf
CheckExportObject.Write "FileSystemObject = Nothing" & vbCrLf
CheckExportObject.Write "Fullpath = Nothing" & vbCrLf
CheckExportObject.Write "DocExportCheckTry = Nothing" & vbCrLf
CheckExportObject.Write "DocExportCheckMaxTrys = Nothing" & vbCrLf
CheckExportObject.Close
ELSE
MSGBOX("ACHTUNG: Das CheckExportScript konnte nicht erstellt werden!")
END IF
END IF
ELSE
MSGBOX("ACHTUNG: Zielpfad für Export konnte nicht erstellt werden! Export wird abgebrochen.")
END IF
ELSE
'Missing Value in DocTargetPath, DocTargetFileName or DocExtension
WScript.Quit(1)
END IF
'#-----------------------------------------------------------------------------------------------------#
'########################################### finishing part ############################################
'#-----------------------------------------------------------------------------------------------------#
FileSystemObject = Nothing
Shell = Nothing
DateTime = Nothing
SplitChar = Nothing
ReplaceSpecialChar = Nothing
DocExtension = Nothing
DocExportCheck = Nothing
DocExportCheckTry = Nothing
DocExportCheckMaxTrys = Nothing
DocType = Nothing
DocVersion = Nothing
DocVersionSeparator = Nothing
MandatorShortName = Nothing
DocAccountNumber = Nothing
DocAANGExportPath = Nothing
DocAABExportPath = Nothing
DocALSExportPath = Nothing
DocAREExportPath = Nothing
DocAANFExportPath = Nothing
DocABExportPath = Nothing
DocAANGConvention = Nothing
DocAABConvention = Nothing
DocALSConvention = Nothing
DocAREConvention = Nothing
DocAANFConvention = Nothing
DocABEConvention = Nothing
DocAANGNumber = Nothing
DocAABNumber = Nothing
DocALSNumber = Nothing
DocARENumber = Nothing
DocAANFNumber = Nothing
DocABENumber = Nothing
DocTargetPath = Nothing
DocTargetFileName = Nothing
FullPath = Nothing
Result = ""

View File

@ -0,0 +1,15 @@
-------------------------------------------------------------------------------
Version 1.0.0.0 - 23.04.2019
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,23 @@
-------------------------------------------------------------------------------
Version 1.0.1.0 - 15.07.2019
NEW: - Added Support for "DocType -3" (Teillieferschein)
FIX: -
CHG: -
REM: -
-------------------------------------------------------------------------------
Version 1.0.0.0 - 23.04.2019
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
-------------------------------------------------------------------------------

Binary file not shown.

After

Width:  |  Height:  |  Size: 8.8 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 23 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 8.9 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 176 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 59 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 97 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 62 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 8.9 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 8.6 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 8.4 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 8.8 KiB

Binary file not shown.

Binary file not shown.

View File

@ -0,0 +1,28 @@
Version 3.1.0.4 - 14.10.2021
NEW: -
FIX: - Fix Error in path creation function (PDFE)
CHG: -
REM: -
-------------------------------------------------------------------------------
Version 3.1.0.0 - 09.10.2021
NEW: - Added Additional Fields (Personenkonten Zusatzfelder)
FIX: -
CHG: -
REM: -
-------------------------------------------------------------------------------
Version 3.0.0.0 - 16.07.2021 (30.08.2021, 09.10.2021) - Erste Version des Relaunchs
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,115 @@
' DeleteExportWinLineDoc_Record
' ----------------------------------------------------------------------------
' Diese Subroutine löscht einen Datensatz anhand einer selktierten Gridzeile.
' Parameter 1 (LEVEL) = Das aktuelle Showlevel übergeben.
' Parameter 2 (GRID) = Falls mehrere Grids auf einem Level vorkommen, kann über diesen Parameter nochmals unterscheiden werden.
' Parameter 3 (ROW) = Zu löschende Zeile im Grid (nur zwecks Anzeige).
' Parameter 4 (GRID) = Eindeutige Nummer des zu löschenden Datensatzes (zwecks Löschung in der DB).
'
' ----------------------------------------------------------------------------
' 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: 04.07.2021 / MD
' Version Date / Editor: 04.07.2021 / MD
' Version Number: 1.0.0.0
Sub DeleteExportWinLineDoc_Record(LEVEL,GRID,ROW,GUID)
If (((LEVEL = 1) or (LEVEL = "1")) and (ROW > 0) and (GUID > 0)) Then
If (GRID = LEVEL1_GRID_ID) Then
MsgBoxQuestion = MsgBox ("Möchten Sie den ausgewählten Datensatz wirklich löschen? " & vbCrlf & vbCrlf & _
"Beschreibung: " & LEVEL1_GRID_CURRENT_Beschreibung & vbCrlf & vbCrlf & _
"Mandant: " & LEVEL1_GRID_CURRENT_Mandant & vbCrlf & vbCrlf & _
"Achtung der Vorgang kann nicht Rückgängig gemacht werden!" & vbCrlf & _
"", vbYesno+vbQuestion, DEFAULT_TITLE & " - Löschen bestätigen!")
If (MsgBoxQuestion = 6) Then
SQLDelete_Profile = REPLACE(SQLDelete_Profile_Template,"%GUID%",GUID)
SQLResult_Profile = Conn.ExecuteSQL(SQLDelete_Profile)
If (SQLResult_Profile = "Wahr") Or (SQLResult_Profile = 1) Then
LEVEL1_Grid.RemoveLine ROW
'LEVEL1_Grid.Refresh << Dont do this selected line will lose
If (LEVEL1_Grid.LineCount > 0) Then
'Show updated count down the table
LEVEL1_TXT_TabelCounter.Contents = (Cstr(LEVEL1_Grid.LineCount) & " Zuordnungen gefunden")
Else
LEVEL1_TXT_TabelCounter.Contents = "Keine Zuordnungen gefunden"
End If
MsgBox "Der Datensatz wurde erfolgreich gelöscht!",vbOkayonly+vbInformation,DEFAULT_TITLE & " - Erfolg!"
Else
MsgBox "Der Datensatz konnte nicht gelöscht werden!",vbOkayonly+vbCritical,DEFAULT_TITLE & " - Fehler!"
End If
End if
End If
ElseIf (((LEVEL = 2) or (LEVEL = "2")) and (ROW > 0) and (GUID > 0)) Then
If (GRID = LEVEL2_GRID_ID) Then
MsgBoxQuestion = MsgBox ("Möchten Sie den ausgewählten Datensatz wirklich löschen? " & vbCrlf & vbCrlf & _
"Beschreibung: " & LEVEL2_GRID_CURRENT_Beschreibung & vbCrlf & vbCrlf & _
"Mandant: " & LEVEL2_GRID_CURRENT_Mandant & vbCrlf & vbCrlf & _
"Achtung der Vorgang kann nicht Rückgängig gemacht werden!" & vbCrlf & _
"", vbYesno+vbQuestion, DEFAULT_TITLE & " - Löschen bestätigen!")
If (MsgBoxQuestion = 6) Then
SQLDelete_Config = REPLACE(SQLDelete_Config_Template,"%GUID%",GUID)
SQLResult_Config = Conn.ExecuteSQL(SQLDelete_Config)
If (SQLResult_Config = "Wahr") Or (SQLResult_Config = 1) Then
LEVEL2_Grid.RemoveLine ROW
'LEVEL2_Grid.Refresh << Dont do this selected line will lose
If (LEVEL2_Grid.LineCount > 0) Then
'Show updated count down the table
LEVEL2_TXT_TabelCounter.Contents = (Cstr(LEVEL2_Grid.LineCount) & " Zuordnungen gefunden")
Else
LEVEL2_TXT_TabelCounter.Contents = "Keine Zuordnungen gefunden"
End If
MsgBox "Der Datensatz wurde erfolgreich gelöscht!",vbOkayonly+vbInformation,DEFAULT_TITLE & " - Erfolg!"
Else
MsgBox "Der Datensatz konnte nicht gelöscht werden!",vbOkayonly+vbCritical,DEFAULT_TITLE & " - Fehler!"
End If
End if
Else
Msgbox "Unzureichende Parameter!" & vbCrlf & _
"LEVEL: " & LEVEL & vbCrlf & _
"ROW: " & ROW & vbCrlf & _
"GUID: " & GUID & vbCrlf & _
"",vbOkayonly+vbCritical,DEFAULT_TITLE & " - Fehler!"
End If
End If
End Sub

View File

@ -0,0 +1,91 @@
' DD-INSERT_LANGBESCHINT_INTO_BELEGERFASSUNG
' ----------------------------------------------------------------------------
' Diese Subroutine deaktiviert Knöpfe im Ribbon und in Fenster.
' Parameter 1 (LEVEL) = Das aktuelle Showlevel übergeben.
' Parameter 2 (CTRLType)= "Static" deaktiviert pauschal, "dynamic" deaktiviert anhand anderer Laufzeitvariablen.
'
' ----------------------------------------------------------------------------
' 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: 16.07.2021 / MK
' Version Date / Editor: 16.07.2021 / MK
' Version Number: 1.0.0.0
Sub DisableExportWinLineDoc_ButtonControls(LEVEL,CTRLType)
If ((LEVEL = 0) or (LEVEL = "0")) and (CTRLType = "static") Then
LEVEL0_BTN_ABORT.Active = False
ElseIf ((LEVEL = 1) or (LEVEL = "1")) and (CTRLType = "static") Then
LEVEL0_BTN_OK.Active = False
LEVEL0_BTN_EXIT.Active = False
LEVEL1_TAB_LEVEL1_TO_LEVEL1.Active = False
LEVEL1_TAB_LEVEL1_TO_LEVEL2.Active = False
LEVEL1_TAB_LEVEL1_TO_LEVEL3.Active = False
ElseIf ((LEVEL = 2) or (LEVEL = "2")) and (CTRLType = "static") Then
LEVEL0_BTN_OK.Active = False
LEVEL0_BTN_EXIT.Active = False
LEVEL2_TAB_LEVEL2_TO_LEVEL1.Active = False
LEVEL2_TAB_LEVEL2_TO_LEVEL2.Active = False
LEVEL2_TAB_LEVEL2_TO_LEVEL3.Active = False
ElseIf ((LEVEL = 1) or (LEVEL = "1")) and (CTRLType = "dynamic") Then
If (LEVEL1_GRID_CURRENT_GUID = -1) Then
LEVEL0_BTN_NEW.Active = False
LEVEL0_BTN_DELETE.Active = False
ElseIf (LEVEL1_GRID_CURRENT_ROW >= 0) and (LEVEL1_GRID_CURRENT_GUID >= 0) Then
LEVEL0_BTN_ABORT.Active = False
LEVEL0_BTN_SAVE.Active = False
LEVEL0_BTN_DELETE.Active = False
ElseIf (LEVEL1_GRID_CURRENT_ROW <= 0) and (LEVEL1_GRID_CURRENT_GUID <= 0) Then
LEVEL0_BTN_SAVE.Active = False
LEVEL0_BTN_DELETE.Active = False
End if
ElseIf ((LEVEL = 2) or (LEVEL = "2")) and (CTRLType = "dynamic") Then
If (LEVEL2_GRID_CURRENT_GUID = -1) Then
LEVEL0_BTN_NEW.Active = False
LEVEL0_BTN_DELETE.Active = False
ElseIf (LEVEL2_GRID_CURRENT_ROW >= 0) and (LEVEL2_GRID_CURRENT_GUID >= 0) Then
LEVEL0_BTN_ABORT.Active = False
LEVEL0_BTN_SAVE.Active = False
LEVEL0_BTN_DELETE.Active = False
ElseIf (LEVEL2_GRID_CURRENT_ROW <= 0) and (LEVEL2_GRID_CURRENT_GUID <= 0) Then
LEVEL0_BTN_SAVE.Active = False
LEVEL0_BTN_DELETE.Active = False
End if
ElseIf ((LEVEL = 3) or (LEVEL = "3")) and (CTRLType = "static") Then
LEVEL0_BTN_OK.Active = False
LEVEL0_BTN_NEW.Active = False
LEVEL0_BTN_DELETE.Active = False
LEVEL0_BTN_SAVE.Active = False
LEVEL0_BTN_DELETE.Active = False
End if
End Sub

View File

@ -0,0 +1,141 @@
' DisableExportWinLineDoc_InputControls
' ----------------------------------------------------------------------------
' Diese Subroutine deaktiviert sämtliche Eingabefelder auf einem Level.
' Parameter 1 (LEVEL) = Das aktuelle Showlevel übergeben.
' Parameter 2 (CTRLType)= "Static" deaktiviert pauschal, "dynamic" deaktiviert anhand anderer Laufzeitvariablen.
'
' ----------------------------------------------------------------------------
' 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: 15.07.2021 / MK
' Version Date / Editor: 15.07.2021 / MK
' Version Number: 1.0.0.0
Sub DisableExportWinLineDoc_InputControls(LEVEL,CTRLType)
If ((LEVEL = 1) or (LEVEL = "1")) and (CTRLType = "static") Then
LEVEL1_CHK_Aktiv.Active = False
LEVEL1_TXT_Beschreibung.Active = False
LEVEL1_TXT_Mandant.Active = False
LEVEL1_TXT_WinLineVariable1.Active = False
LEVEL1_TXT_WinLineVariable2.Active = False
LEVEL1_TXT_WinLineVariable3.Active = False
LEVEL1_TXT_WinLineVariable4.Active = False
LEVEL1_TXT_WinLineVariable5.Active = False
LEVEL1_TXT_WinLineVariable6.Active = False
LEVEL1_TXT_WinLineVariable7.Active = False
LEVEL1_TXT_WinLineVariable8.Active = False
LEVEL1_TXT_WinLineVariable9.Active = False
LEVEL1_TXT_WinLineVariable10.Active = False
LEVEL1_TXT_CallMakroPreExport1.Active = False
LEVEL1_TXT_CallMakroPreExport2.Active = False
LEVEL1_TXT_CallMakroPreExport3.Active = False
LEVEL1_TXT_CallMakroPreExport4.Active = False
LEVEL1_TXT_CallMakroPreExport5.Active = False
LEVEL1_TXT_CallMakroPreExport6.Active = False
LEVEL1_TXT_CallMakroPreExport7.Active = False
LEVEL1_TXT_CallMakroPreExport8.Active = False
LEVEL1_TXT_CallMakroPreExport9.Active = False
LEVEL1_TXT_CallMakroPreExport10.Active = False
LEVEL1_TXT_ExportPfad.Active = False
LEVEL1_TXT_ExportDateiname.Active = False
LEVEL1_TXT_ExportDateinameVorschau.Active = False
LEVEL1_TXT_ExportDateiendung.Active = False
LEVEL1_TXT_ExportVersionierung.Active = False
LEVEL1_BTN_VariableEinfuegen1.Active = False
LEVEL1_BTN_VariableEinfuegen2.Active = False
LEVEL1_BTN_VariableEinfuegen3.Active = False
ElseIf ((LEVEL = 2) or (LEVEL = "2")) and (CTRLType = "static") Then
LEVEL2_CHK_Aktiv.Active = False
LEVEL2_TXT_Beschreibung.Active = False
LEVEL2_TXT_Mandant.Active = False
LEVEL2_TXT_Eintragstyp.Active = False
LEVEL2_TXT_Platzhalter.Active = False
LEVEL2_TXT_Datentyp.Active = False
LEVEL2_TXT_Text_Wert.Active = False
LEVEL2_TXT_Integer_Wert.Active = False
LEVEL2_TXT_Double_Wert.Active = False
LEVEL2_TXT_Date_Wert.Active = False
ElseIf ((LEVEL = 2) or (LEVEL = "2")) and (CTRLType = "dynamic") Then
IF (Instr( 1, LEVEL2_TXT_Datentyp.screencontents, "Text", vbTextCompare ) > 0) Then
LEVEL2_TXT_Text_Wert.Active = True
LEVEL2_TXT_Integer_Wert.Active = True
LEVEL2_TXT_Integer_Wert.Contents = 0
LEVEL2_TXT_Integer_Wert.Active = False
LEVEL2_TXT_Double_Wert.Active = True
LEVEL2_TXT_Double_Wert.Contents = 0.0
LEVEL2_TXT_Double_Wert.Active = False
LEVEL2_TXT_Date_Wert.Active = True
LEVEL2_TXT_Date_Wert.Contents = "01.01.1970"
LEVEL2_TXT_Date_Wert.Active = False
ElseIf (Instr( 1, LEVEL2_TXT_Datentyp.screencontents, "Integer", vbTextCompare ) > 0) Then
LEVEL2_TXT_Text_Wert.Active = True
LEVEL2_TXT_Text_Wert.Contents = ""
LEVEL2_TXT_Text_Wert.Active = False
LEVEL2_TXT_Integer_Wert.Active = True
LEVEL2_TXT_Double_Wert.Active = True
LEVEL2_TXT_Double_Wert.Contents = 0.0
LEVEL2_TXT_Double_Wert.Active = False
LEVEL2_TXT_Date_Wert.Active = True
LEVEL2_TXT_Date_Wert.Contents = "01.01.1970"
LEVEL2_TXT_Date_Wert.Active = False
ElseIf (Instr( 1, LEVEL2_TXT_Datentyp.screencontents, "Double", vbTextCompare ) > 0) Then
LEVEL2_TXT_Text_Wert.Active = True
LEVEL2_TXT_Text_Wert.Contents = ""
LEVEL2_TXT_Text_Wert.Active = False
LEVEL2_TXT_Integer_Wert.Active = True
LEVEL2_TXT_Integer_Wert.Contents = 0
LEVEL2_TXT_Integer_Wert.Active = False
LEVEL2_TXT_Double_Wert.Active = True
LEVEL2_TXT_Date_Wert.Active = True
LEVEL2_TXT_Date_Wert.Contents = "01.01.1970"
LEVEL2_TXT_Date_Wert.Active = False
ElseIf (Instr( 1, LEVEL2_TXT_Datentyp.screencontents, "Date", vbTextCompare ) > 0) Then
LEVEL2_TXT_Text_Wert.Active = True
LEVEL2_TXT_Text_Wert.Contents = ""
LEVEL2_TXT_Text_Wert.Active = False
LEVEL2_TXT_Integer_Wert.Active = True
LEVEL2_TXT_Integer_Wert.Contents = 0
LEVEL2_TXT_Integer_Wert.Active = False
LEVEL2_TXT_Double_Wert.Active = True
LEVEL2_TXT_Double_Wert.Contents = 0.0
LEVEL2_TXT_Double_Wert.Active = False
LEVEL2_TXT_Date_Wert.Active = True
End if
End if
End Sub

View File

@ -0,0 +1,85 @@
' EnableExportWinLineDoc_ButtonControls
' ----------------------------------------------------------------------------
' Diese Subroutine aktiviert Knöpfe im Ribbon und in Fenster.
' Parameter 1 (LEVEL) = Das aktuelle Showlevel übergeben.
' Parameter 2 (CTRLType)= "Static" aktiviert pauschal, "dynamic" aktiviert anhand anderer Laufzeitvariablen.
'
' ----------------------------------------------------------------------------
' 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: 29.06.2021 / MK
' Version Date / Editor: 29.06.2021 / MK
' Version Number: 1.0.0.0
Sub EnableExportWinLineDoc_ButtonControls(LEVEL,CTRLType)
If ((LEVEL = 0) or (LEVEL = "0")) and (CTRLType = "static") Then
LEVEL0_BTN_ABORT.Active = True
ElseIf ((LEVEL = 1) or (LEVEL = "1")) and (CTRLType = "static") Then
LEVEL0_BTN_OK.Active = True
LEVEL0_BTN_EXIT.Active = True
LEVEL1_TAB_LEVEL1_TO_LEVEL1.Active = True
LEVEL1_TAB_LEVEL1_TO_LEVEL2.Active = True
LEVEL1_TAB_LEVEL1_TO_LEVEL3.Active = True
ElseIf ((LEVEL = 2) or (LEVEL = "2")) and (CTRLType = "static") Then
LEVEL0_BTN_OK.Active = True
LEVEL0_BTN_EXIT.Active = True
LEVEL2_TAB_LEVEL2_TO_LEVEL1.Active = True
LEVEL2_TAB_LEVEL2_TO_LEVEL2.Active = True
LEVEL2_TAB_LEVEL2_TO_LEVEL3.Active = True
ElseIf ((LEVEL = 1) or (LEVEL = "1")) and (CTRLType = "dynamic") Then
If (LEVEL1_GRID_CURRENT_GUID = -1) Then
LEVEL0_BTN_ABORT.Active = TRUE
LEVEL0_BTN_SAVE.Active = True
ElseIf (LEVEL1_GRID_CURRENT_ROW > 0) and (LEVEL1_GRID_CURRENT_GUID > 0) Then
LEVEL0_BTN_OK.Active = True
LEVEL0_BTN_NEW.Active = True
LEVEL0_BTN_SAVE.Active = True
LEVEL0_BTN_DELETE.Active = True
ElseIf (LEVEL1_GRID_CURRENT_ROW = 0) and (LEVEL1_GRID_CURRENT_GUID = 0) Then
LEVEL0_BTN_OK.Active = True
LEVEL0_BTN_NEW.Active = True
End if
ElseIf ((LEVEL = 2) or (LEVEL = "2")) and (CTRLType = "dynamic") Then
If (LEVEL2_GRID_CURRENT_GUID = -1) Then
LEVEL0_BTN_ABORT.Active = TRUE
LEVEL0_BTN_SAVE.Active = True
ElseIf (LEVEL2_GRID_CURRENT_ROW > 0) and (LEVEL2_GRID_CURRENT_GUID > 0) Then
LEVEL0_BTN_OK.Active = True
LEVEL0_BTN_NEW.Active = True
LEVEL0_BTN_SAVE.Active = True
LEVEL0_BTN_DELETE.Active = True
ElseIf (LEVEL2_GRID_CURRENT_ROW = 0) and (LEVEL2_GRID_CURRENT_GUID = 0) Then
LEVEL0_BTN_OK.Active = True
LEVEL0_BTN_NEW.Active = True
End if
End if
End Sub

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