8
0
2024-01-24 16:42:38 +01:00

211 lines
6.5 KiB
Plaintext

' PacktischHistorySQL()
' ----------------------------------------------------------------------------
' Stellt Methoden für den Zugriff auf die Tabelle Packtisch bereit
'
' Returns: -
' ----------------------------------------------------------------------------
' 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: 15.02.2022 / MP
' Version Date / Editor: 01.06.2023 / MP/JJ
' Version Number: 4.1.0.0
Sub InsertPacktischHistoryRow(AuftragsNr, ArtikelNr, PseudoSN)
Set Conn = CWLStart.Connection
Err.Clear
Dim NowObject : NowObject = Now
Dim DateString : DateString = Year(NowObject) & "-" & GetLeftPad(Month(NowObject)) & "-" & GetLeftPad(Day(NowObject))
Dim TimeString : TimeString = GetLeftPad(Hour(NowObject)) & ":" & GetLeftPad(Minute(NowObject)) & ":" & GetLeftPad(Second(NowObject))
Dim RechnerName : RechnerName = GetWindowsEnvironment("COMPUTERNAME")
Dim InsertSQL : InsertSQL = ""
InsertSQL = InsertSQL & "INSERT INTO dbo.TBDD_PACKTISCH_HISTORY "
InsertSQL = InsertSQL & " ([AuftragsNr] "
InsertSQL = InsertSQL & " ,[ArtikelNr] "
InsertSQL = InsertSQL & " ,[PseudoSN] "
InsertSQL = InsertSQL & " ,[Rechnername] "
InsertSQL = InsertSQL & " ,[ErstelltWann] "
InsertSQL = InsertSQL & " ,[PacktischVersion] "
InsertSQL = InsertSQL & " ,[mesocomp] "
InsertSQL = InsertSQL & " ,[mesoyear] "
InsertSQL = InsertSQL & " ,[Status] "
InsertSQL = InsertSQL & " ) VALUES ( "
InsertSQL = InsertSQL & "'" & AuftragsNr & "', "
InsertSQL = InsertSQL & "'" & ArtikelNr & "', "
InsertSQL = InsertSQL & "'" & PseudoSN & "', "
InsertSQL = InsertSQL & "'" & RechnerName & "', "
InsertSQL = InsertSQL & "'" & DateString & " " & TimeString & "', "
InsertSQL = InsertSQL & "'" & PACKTISCH_VERSION & "', "
InsertSQL = InsertSQL & "'" & MandatorNr & "', "
InsertSQL = InsertSQL & "'" & WinlineCurrentYear & "', "
InsertSQL = InsertSQL & "'Locked'"
InsertSQL = InsertSQL & " ) "
Result = Conn.ExecuteSQL(InsertSQL)
If DEBUG_ON = True Then
AddDebugLine "TBDD_PACKTISCH_HISTORY - Insert"
AddDebugLine "SQL: " & InsertSQL
ShowDebugBox "InsertPacktischHistoryRow"
End If
If Result = False Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - InsertPacktischHistoryRow"
Exit Sub
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - InsertPacktischHistoryRow"
Exit Sub
End If
End If
End Sub
Sub UpdatePacktischHistoryRow(AuftragsNr, ArtikelNr, PseudoSN, Status, RealSN)
Set Conn = CWLStart.Connection
Err.Clear
Dim NowObject : NowObject = Now
Dim DateString : DateString = Year(NowObject) & "-" & GetLeftPad(Month(NowObject)) & "-" & GetLeftPad(Day(NowObject))
Dim TimeString : TimeString = GetLeftPad(Hour(NowObject)) & ":" & GetLeftPad(Minute(NowObject)) & ":" & GetLeftPad(Second(NowObject))
Dim RechnerName : RechnerName = GetWindowsEnvironment("COMPUTERNAME")
Dim UpdateSQL : UpdateSQL = ""
UpdateSQL = UpdateSQL & "UPDATE dbo.TBDD_PACKTISCH_HISTORY "
UpdateSQL = UpdateSQL & "SET [Status] = '" & Status & "', "
UpdateSQL = UpdateSQL & "[GeaendertWann] = '" & DateString & " " & TimeString & "' "
If Len(RealSN) > 0 Then
UpdateSQL = UpdateSQL & ", RealSN = '" & RealSN & "' "
End If
UpdateSQL = UpdateSQL & "WHERE AuftragsNr = '" & AuftragsNr & "' AND "
UpdateSQL = UpdateSQL & "ArtikelNr = '" & ArtikelNr & "' AND "
UpdateSQL = UpdateSQL & "PseudoSN = '" & PseudoSN & "' AND "
UpdateSQL = UpdateSQL & "Rechnername = '" & RechnerName & "'"
If DEBUG_ON = True Then
AddDebugLine "TBDD_PACKTISCH_HISTORY - Update"
AddDebugLine "SQL: " & UpdateSQL
ShowDebugBox "UpdatePacktischHistoryRow"
End If
Result = Conn.ExecuteSQL(UpdateSQL)
If Result = False Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - UpdatePacktischHistoryRow"
Exit Sub
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - UpdatePacktischHistoryRow"
Exit Sub
End If
End If
End Sub
Sub UpdatePacktischHistoryRowsAfterSuccess(AuftragsNr)
Set Conn = CWLStart.Connection
Err.Clear
Dim NowObject : NowObject = Now
Dim DateString : DateString = Year(NowObject) & "-" & GetLeftPad(Month(NowObject)) & "-" & GetLeftPad(Day(NowObject))
Dim TimeString : TimeString = GetLeftPad(Hour(NowObject)) & ":" & GetLeftPad(Minute(NowObject)) & ":" & GetLeftPad(Second(NowObject))
Dim RechnerName : RechnerName = GetWindowsEnvironment("COMPUTERNAME")
Dim UpdateSQL : UpdateSQL = ""
UpdateSQL = UpdateSQL & "UPDATE dbo.TBDD_PACKTISCH_HISTORY "
UpdateSQL = UpdateSQL & "SET [Status] = 'Used', "
UpdateSQL = UpdateSQL & "[GeaendertWann] = '" & DateString & " " & TimeString & "' "
UpdateSQL = UpdateSQL & "WHERE AuftragsNr = '" & AuftragsNr & "' AND "
UpdateSQL = UpdateSQL & "Rechnername = '" & RechnerName & "' AND "
UpdateSQL = UpdateSQL & "RealSN IS NOT NULL"
If DEBUG_ON = True Then
AddDebugLine "TBDD_PACKTISCH_HISTORY - Update"
AddDebugLine "SQL: " & UpdateSQL
ShowDebugBox "UpdatePacktischHistoryRowsAfterSuccess"
End If
Result = Conn.ExecuteSQL(UpdateSQL)
If Result = False Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - UpdatePacktischHistoryRowsAfterSuccess"
Exit Sub
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - UpdatePacktischHistoryRowsAfterSuccess"
Exit Sub
End If
End If
End Sub
Sub DeletePacktischHistoryRows()
Set Conn = CWLStart.Connection
Err.Clear
Dim RechnerName : RechnerName = GetWindowsEnvironment("COMPUTERNAME")
Dim DeleteSQL : DeleteSQL = ""
DeleteSQL = DeleteSQL & "DELETE FROM dbo.TBDD_PACKTISCH_HISTORY WHERE Rechnername = '" & Rechnername & "' "
DeleteSQL = DeleteSQL & "AND Status <> 'Used'"
If DEBUG_ON = True Then
AddDebugLine "TBDD_PACKTISCH_HISTORY - Delete"
AddDebugLine "SQL: " & UpdateSQL
ShowDebugBox "DeletePacktischHistoryRows"
End If
Result = Conn.ExecuteSQL(DeleteSQL)
If Result = False Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - DeletePacktischHistoryRows"
Exit Sub
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - DeletePacktischHistoryRows"
Exit Sub
End If
End If
End Sub