Anlage des Repos
This commit is contained in:
@@ -0,0 +1,372 @@
|
||||
'Remark: Digital Data - Manuelles Wertesetzen von Zusatzfeldern im Mandantenstamm
|
||||
'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.0.0.0
|
||||
'Version Date: 16.03.2020
|
||||
|
||||
On Error Resume Next
|
||||
|
||||
'########## set variables ##########
|
||||
|
||||
DebugMode = "Disabled" 'Set to "Enabled", to get debug msgboxes. Default: "Disabled"
|
||||
MandatorNr = CWLStart.CurrentCompany 'Get current MandantorNr, like "500M".
|
||||
CurrentUser = CWLStart.CurrentUser 'Get current username like "meso".
|
||||
Timestamp = Now 'Get current date and time.
|
||||
|
||||
LoopCounterCaptions = 4 'Do not change! Default: 4
|
||||
LoopMaxCaptions = 34 'Do not change! Default: 34
|
||||
LoopCounterValues = 1 'Do not change! Default: 1
|
||||
LoopMaxValues = 31 'Do not change! Default: 31
|
||||
|
||||
SQLTableCaptions = "T074" 'Set SQL Table for Captions. Default: "T074"
|
||||
SQLQueryCaptions = "(c000 = 'DES-001-0000') and (mesocomp = '~~~~') and (mesoyear = yyyy)" 'SQL Result has to be ONE line! Default: "(c000 = 'DES-001-0000') and (mesocomp = '~~~~') and (mesoyear = yyyy)"
|
||||
|
||||
SQLTableValues = "T057" 'Set SQL Table for Values. Default: "T057"
|
||||
SQLQueryValues = "(c032 = 'comp') and (mesocomp = '~~~~') and (mesoyear = yyyy)" 'SQL Result has to be ONE or MULTIPLE lines! Default: "(c032 = 'comp') and (mesocomp = '~~~~') and (mesoyear = yyyy)"
|
||||
|
||||
SimpleInputBoxs = Array() 'Set Fields from "Zusatzfeldern im Mandantenstamm", like SimpleInputBoxs = Array("MK Kupfernotation")
|
||||
SimpleInputBoxsReplace = Array(",",".") 'Set a character to be replaced. I case of float fields very important! Default: Array(",",".")
|
||||
|
||||
EnhancedInputBoxs = Array() 'Set Fields from "Zusatzfeldern im Mandantenstamm", like EnhancedInputBoxs = Array("Obere Kupfernotation","Untere Kupfernotation")
|
||||
EnhancedInputBoxsReplace = Array(",",".") 'Set a character to be replaced. I case of float fields very important! Default: Array(",",".")
|
||||
|
||||
SummaryMessage = "Enabled" 'Set to "Enabled", to get a msgbox at the end about all values. Default: Enabled
|
||||
|
||||
'########## preparing part ##########
|
||||
|
||||
'Reset Error Var
|
||||
Err.Clear
|
||||
|
||||
'Display debug infos, if enabled
|
||||
If DebugMode = "Enabled" Then
|
||||
|
||||
MSGBOX "CurrentUser: " & CurrentUser & vbCrlf & _
|
||||
"MandatorNr: " & MandatorNr & vbCrlf & _
|
||||
"Timestamp: " & Timestamp,,"DEBUG - Info: Runtime Variables"
|
||||
|
||||
End If
|
||||
|
||||
'########## main part ##########
|
||||
|
||||
'Query to get captions
|
||||
Set SQLResultCaptions = CWLStart.CurrentCompany.SearchRecord (SQLTableCaptions, SQLQueryCaptions)
|
||||
|
||||
If Err.Number <> 0 Then
|
||||
MSGBOX "Error Code: "& Err.Number & vbCrlf & _
|
||||
"Error Description: "& Err.Description,,"ERROR: Getting Captions from DB Table "& SQLTableCaptions
|
||||
Err.Clear
|
||||
Else
|
||||
|
||||
'If no line results
|
||||
If SQLResultCaptions.RowCount = -1 Then
|
||||
|
||||
If DebugMode = "Enabled" Then
|
||||
MSGBOX "No Rows found, SQL: "& SQLQueryCaptions,,"DEBUG - Info: Captions from Database table "& SQLTableCaptions
|
||||
End If
|
||||
|
||||
ElseIF SQLLinesCaptions > 1 Then
|
||||
|
||||
If DebugMode = "Enabled" Then
|
||||
MSGBOX "To many rows found, SQL: "& SQLQueryCaptions,,"DEBUG - Info: Captions from Database table "& SQLTableCaptions
|
||||
End If
|
||||
|
||||
'Whole function needs defined caption names of the additional fields
|
||||
Else
|
||||
|
||||
SQLLinesCaptions = SQLResultCaptions.RowCount
|
||||
|
||||
If DebugMode = "Enabled" Then
|
||||
|
||||
MSGBOX "SQL-Lines: " & SQLLinesCaptions & vbCrlf & _
|
||||
"SQL-Columns: " & SQLResultCaptions & vbCrlf & _
|
||||
"SQL-Table: " & SQLTableCaptions & vbCrlf & _
|
||||
"SQL-Query: " & SQLQueryCaptions,,"DEBUG - Info: Query for Captions is a SUCCESS!"
|
||||
End If
|
||||
|
||||
'Query to get values of set captions
|
||||
Set SQLResultValues = CWLStart.CurrentCompany.SearchRecord (SQLTableValues, SQLQueryValues)
|
||||
|
||||
If Err.Number <> 0 Then
|
||||
MSGBOX "Error Code: "& Err.Number & vbCrlf & _
|
||||
"Error Description: "& Err.Description,,"ERROR: Getting Values from DB Table "& SQLQueryValues
|
||||
Err.Clear
|
||||
|
||||
Else
|
||||
|
||||
'If no line results
|
||||
If SQLResultValues.RowCount = -1 Then
|
||||
|
||||
If DebugMode = "Enabled" Then
|
||||
MSGBOX "No Rows found, SQL: "& SQLQueryCaptions,,"DEBUG - Info: Captions from Database table "& SQLTableCaptions
|
||||
End If
|
||||
|
||||
ElseIF SQLResultValues.RowCount >= 1 Then
|
||||
|
||||
SQLLinesValues = SQLResultValues.RowCount
|
||||
|
||||
If DebugMode = "Enabled" Then
|
||||
|
||||
MSGBOX "SQL-Lines: " & SQLLinesValues & vbCrlf & _
|
||||
"SQL-Columns: " & SQLResultValues & vbCrlf & _
|
||||
"SQL-Table: " & SQLTableValues & vbCrlf & _
|
||||
"SQL-Query: " & SQLQueryValues,,"DEBUG - Info: Query for Values is a SUCCESS!"
|
||||
End If
|
||||
|
||||
'loop for every caption (db column)
|
||||
Do
|
||||
|
||||
'loop for inputboxes with less metadata usage
|
||||
For Each SimpleInputBox in SimpleInputBoxs
|
||||
|
||||
If SQLResultCaptions.value(LoopCounterCaptions) = SimpleInputBox Then
|
||||
|
||||
If DebugMode = "Enabled" Then
|
||||
|
||||
MSGBOX "SimpleInputBox: " & SimpleInputBox ,,"DEBUG - Info: SimpleInputBox"
|
||||
|
||||
End If
|
||||
|
||||
'Reset SQLResultValues, because NextRecord know no reverse
|
||||
Set SQLResultValues = CWLStart.CurrentCompany.SearchRecord (SQLTableValues, SQLQueryValues)
|
||||
|
||||
SQLResultOldValue = ""
|
||||
SQLResultOldValues = ""
|
||||
|
||||
For LoopSQLLinesValues = 1 to SQLLinesValues
|
||||
|
||||
SQLResultOldValue = "Aktuell: " & SQLResultValues.value(LoopCounterValues) & chr (13)
|
||||
SQLResultOldValues = SQLResultOldValues + SQLResultOldValue
|
||||
|
||||
SQLResultValues.NextRecord
|
||||
|
||||
Next
|
||||
|
||||
If DebugMode = "Enabled" Then
|
||||
|
||||
MSGBOX SQLResultCaptions.ColumnName(LoopCounterCaptions) & " from " & SQLTableCaptions & " on loop count " & LoopCounterCaptions & " includes this caption:" & vbCrlf & _
|
||||
SQLResultCaptions.value(LoopCounterCaptions) & vbCrlf & vbCrlf & _
|
||||
SQLResultValues.ColumnName(LoopCounterCaptions) & " from " & SQLTableValues & " on loop count " & LoopCounterValues & " includes this value(s) (" & SQLLinesValues & " line(s)):" & vbCrlf & _
|
||||
SQLResultOldValues,,"DEBUG - Info: Summary of SQL Querys"
|
||||
|
||||
End If
|
||||
|
||||
If SQLLinesValues > 1 Then
|
||||
|
||||
InputBoxHeadText = "Bitte um Eingabe: " & SQLResultCaptions.value(LoopCounterCaptions) & " (" & SQLLinesValues & " Mandanten)" 'Everytime multi line
|
||||
InputBoxBodyText = SQLResultOldValues
|
||||
InputBoxNewValue = SQLResultValues.value(LoopCounterValues)
|
||||
|
||||
Else
|
||||
|
||||
InputBoxHeadText = "Bitte um Eingabe: " & SQLResultCaptions.value(LoopCounterCaptions) & " (" & SQLLinesValues & " Mandant)" 'Everytime multi line
|
||||
InputBoxBodyText = SQLResultOldValues
|
||||
InputBoxNewValue = SQLResultValues.value(LoopCounterValues)
|
||||
|
||||
End if
|
||||
|
||||
InputBoxValue = InputBox (InputBoxBodyText, InputBoxHeadText, InputBoxNewValue)
|
||||
|
||||
If (InputBoxValue <> "") And (InputBoxValue <> " ") Then
|
||||
|
||||
IF InStr(InputBoxValue,SimpleInputBoxsReplace(0)) > 0 Then
|
||||
InputBoxValue = Replace(InputBoxValue,SimpleInputBoxsReplace(0),SimpleInputBoxsReplace(1))
|
||||
END IF
|
||||
|
||||
If DebugMode = "Enabled" Then
|
||||
|
||||
MSGBOX "SQL-Table: " & SQLTableValues & vbCrlf & _
|
||||
"SQL-Column: " & SQLResultValues.ColumnName(LoopCounterValues) & vbCrlf & _
|
||||
"SQL-Value: " & InputBoxValue & vbCrlf & _
|
||||
"SQL-Update: " & SQLQueryValues,,"DEBUG - Info: Update preview!"
|
||||
End If
|
||||
|
||||
'Start update order into SQL DB
|
||||
CWLStart.CurrentCompany.UpdateRecord SQLTableValues, SQLResultValues.ColumnName(LoopCounterValues) & " = '"& InputBoxValue &"'", SQLQueryValues
|
||||
|
||||
If Err.Number <> 0 Then
|
||||
MSGBOX "Error Code: "& Err.Number & vbCrlf & _
|
||||
"Error Description: "& Err.Description,,"ERROR: Setting Values to DB Table "& SQLTableValues
|
||||
Err.Clear
|
||||
End If
|
||||
|
||||
If SummaryMessage = "Enabled" Then
|
||||
|
||||
SummaryMessageText = SummaryMessageText + SQLResultCaptions.value(LoopCounterCaptions) & " = " & InputBoxValue & chr (13)
|
||||
|
||||
End if
|
||||
|
||||
Else
|
||||
|
||||
MSGBOX "Es wird keine Änderung vorgenommen.",,"Ungültige oder abgebrochene Eingabe!"
|
||||
|
||||
If SummaryMessage = "Enabled" Then
|
||||
|
||||
SummaryMessageText = SummaryMessageText + SQLResultCaptions.value(LoopCounterCaptions) & " = <keine Eingabe erfolgt>" & chr (13)
|
||||
|
||||
End if
|
||||
|
||||
End If
|
||||
|
||||
End if
|
||||
|
||||
Next
|
||||
|
||||
'loop for inputboxes with more metadata usage
|
||||
For Each EnhancedInputBox in EnhancedInputBoxs
|
||||
|
||||
If SQLResultCaptions.value(LoopCounterCaptions) = EnhancedInputBox Then
|
||||
|
||||
If DebugMode = "Enabled" Then
|
||||
|
||||
MSGBOX "EnhancedInputBox: " & EnhancedInputBox ,,"DEBUG - Info: EnhancedInputBox"
|
||||
|
||||
End If
|
||||
|
||||
'Reset SQLResultValues, because NextRecord know no reverse
|
||||
Set SQLResultValues = CWLStart.CurrentCompany.SearchRecord (SQLTableValues, SQLQueryValues)
|
||||
|
||||
SQLResultOldValue = ""
|
||||
SQLResultOldValues = ""
|
||||
|
||||
For LoopSQLLinesValues = 1 to SQLLinesValues
|
||||
|
||||
SQLResultOldValue = "Aktuell: " & SQLResultValues.value(LoopCounterValues) & chr (13)
|
||||
SQLResultOldValues = SQLResultOldValues + SQLResultOldValue
|
||||
|
||||
SQLResultValues.NextRecord
|
||||
|
||||
Next
|
||||
|
||||
If DebugMode = "Enabled" Then
|
||||
|
||||
MSGBOX SQLResultCaptions.ColumnName(LoopCounterCaptions) & " from " & SQLTableCaptions & " on loop count " & LoopCounterCaptions & " includes this caption:" & vbCrlf & _
|
||||
SQLResultCaptions.value(LoopCounterCaptions) & vbCrlf & vbCrlf & _
|
||||
SQLResultValues.ColumnName(LoopCounterCaptions) & " from " & SQLTableValues & " on loop count " & LoopCounterValues & " includes this value(s) (" & SQLLinesValues & " line(s)):" & vbCrlf & _
|
||||
SQLResultOldValues,,"DEBUG - Info: Summary of SQL Querys"
|
||||
|
||||
End If
|
||||
|
||||
If SQLLinesValues > 1 Then
|
||||
|
||||
InputBoxHeadText = "Bitte um Eingabe: " & SQLResultCaptions.value(LoopCounterCaptions) & " (" & SQLLinesValues & " Mandanten)" 'Everytime multi line
|
||||
InputBoxBodyText = SQLResultOldValues
|
||||
InputBoxNewValue = SQLResultValues.value(LoopCounterValues)
|
||||
|
||||
Else
|
||||
|
||||
InputBoxHeadText = "Bitte um Eingabe: " & SQLResultCaptions.value(LoopCounterCaptions) & " (" & SQLLinesValues & " Mandant)" 'Everytime multi line
|
||||
InputBoxBodyText = SQLResultOldValues
|
||||
InputBoxNewValue = SQLResultValues.value(LoopCounterValues)
|
||||
|
||||
End if
|
||||
|
||||
'Special for enhanced inputboxes, remove additional data for the input line
|
||||
InputBoxNewValues = Split(InputBoxNewValue, " | ")
|
||||
InputBoxNewValue = InputBoxNewValues(0)
|
||||
|
||||
InputBoxValue = InputBox (InputBoxBodyText, InputBoxHeadText, InputBoxNewValue)
|
||||
|
||||
If (InputBoxValue <> "") And (InputBoxValue <> " ") Then
|
||||
|
||||
IF InStr(InputBoxValue,EnhancedInputBoxsReplace(0)) > 0 Then
|
||||
InputBoxValue = Replace(InputBoxValue,EnhancedInputBoxsReplace(0),EnhancedInputBoxsReplace(1))
|
||||
END IF
|
||||
|
||||
'Special for enhanced inputboxes, add additional data for the update order
|
||||
InputBoxValue = InputBoxValue & " | Eingetragen von: " & CurrentUser & " | Am/Um: " & Timestamp
|
||||
|
||||
If DebugMode = "Enabled" Then
|
||||
|
||||
MSGBOX "SQL-Table: " & SQLTableValues & vbCrlf & _
|
||||
"SQL-Column: " & SQLResultValues.ColumnName(LoopCounterValues) & vbCrlf & _
|
||||
"SQL-Value: " & InputBoxValue & vbCrlf & _
|
||||
"SQL-Update: " & SQLQueryValues,,"DEBUG - Info: Update preview!"
|
||||
End If
|
||||
|
||||
'Start update order into SQL DB
|
||||
CWLStart.CurrentCompany.UpdateRecord SQLTableValues, SQLResultValues.ColumnName(LoopCounterValues) & " = '"& InputBoxValue &"'", SQLQueryValues
|
||||
|
||||
If Err.Number <> 0 Then
|
||||
MSGBOX "Error Code: "& Err.Number & vbCrlf & _
|
||||
"Error Description: "& Err.Description,,"ERROR: Setting Values to DB Table "& SQLTableValues
|
||||
Err.Clear
|
||||
End If
|
||||
|
||||
If SummaryMessage = "Enabled" Then
|
||||
|
||||
SummaryMessageText = SummaryMessageText + SQLResultCaptions.value(LoopCounterCaptions) & " = " & InputBoxValue & chr (13)
|
||||
|
||||
End if
|
||||
|
||||
Else
|
||||
|
||||
MSGBOX "Es wird keine Änderung vorgenommen.",,"Ungültige oder abgebrochene Eingabe!"
|
||||
|
||||
If SummaryMessage = "Enabled" Then
|
||||
|
||||
SummaryMessageText = SummaryMessageText + SQLResultCaptions.value(LoopCounterCaptions) & " = <keine Eingabe erfolgt>" & chr (13)
|
||||
|
||||
End if
|
||||
|
||||
End If
|
||||
|
||||
End if
|
||||
|
||||
Next
|
||||
|
||||
LoopCounterCaptions = LoopCounterCaptions + 1
|
||||
LoopCounterValues = LoopCounterValues + 1
|
||||
|
||||
Loop Until (LoopCounterCaptions >= LoopMaxCaptions) Or (LoopCounterValues >= LoopMaxValues)
|
||||
|
||||
If SummaryMessage = "Enabled" Then
|
||||
|
||||
If (SQLLinesValues = 1) And (SummaryMessageText > "") Then
|
||||
|
||||
SummaryMessageText = SummaryMessageText + chr (13) & chr (13) & "Getätigte Eingaben wirken sich unmittelbar " & chr (13) & "auf 1 Mandant aus!"
|
||||
|
||||
Elseif SQLLinesValues > 1 And (SummaryMessageText > "") Then
|
||||
|
||||
SummaryMessageText = SummaryMessageText + chr (13) & chr (13) & "Getätigte Eingaben wirken sich unmittelbar " & chr (13) & "auf " & SQLLinesValues & " Mandanten aus!"
|
||||
|
||||
Elseif SummaryMessageText = "" Then
|
||||
|
||||
SummaryMessageText = "Ungültige Konfiguration, bitte kontaktieren Sie Ihren Administrator!"
|
||||
|
||||
Else
|
||||
|
||||
SummaryMessageText = "Fehler bei der Verarbeitung, bitte kontaktieren Sie Ihren Administrator!"
|
||||
|
||||
end if
|
||||
|
||||
MSGBOX SummaryMessageText,,"Zusammenfassung sämtlicher Änderungen."
|
||||
|
||||
End if
|
||||
|
||||
End if
|
||||
|
||||
End If
|
||||
|
||||
End If
|
||||
|
||||
End If
|
||||
|
||||
'########## final part ##########
|
||||
If DebugMode = "Enabled" Then
|
||||
'Sub RunMacro
|
||||
' Return to Macro Window
|
||||
MApplication 2
|
||||
MApplication 0
|
||||
MWindow 45, False
|
||||
MSetFieldFocus 45, 100
|
||||
MSetFieldFocus 45, -1
|
||||
MSetFieldFocus 45, -1
|
||||
MActivateWindow 45
|
||||
'End Sub
|
||||
End if
|
||||
Reference in New Issue
Block a user