372 lines
13 KiB
VB.net
372 lines
13 KiB
VB.net
'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 |