92 lines
2.8 KiB
Plaintext
92 lines
2.8 KiB
Plaintext
' AllocatePseudoSerialNumbers()
|
|
' ----------------------------------------------------------------------------
|
|
' 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: 22.02.2022 / MP
|
|
' Version Date / Editor: 22.03.2022 / MP
|
|
' Version Number: 4.0.0.0
|
|
|
|
|
|
Function AllocatePseudoSerialNumbers(AuftragsNr, ArtikelNr, AmountToAllocate)
|
|
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 AllocateSQL : AllocateSQL = ""
|
|
AllocateSQL = AllocateSQL & "select top " & AmountToAllocate & " c068 "
|
|
AllocateSQL = AllocateSQL & "from v021 (NOLOCK)"
|
|
AllocateSQL = AllocateSQL & "where c068 like '" & ArtikelNr & "-________-____' "
|
|
AllocateSQL = AllocateSQL & "and c038 is null "
|
|
AllocateSQL = AllocateSQL & "and (c008 - c009) = 1 "
|
|
AllocateSQL = AllocateSQL & "and c068 not in (SELECT PseudoSN from TBDD_PACKTISCH_HISTORY (NOLOCK) WHERE ArtikelNr = '" & ArtikelNr & "') "
|
|
AllocateSQL = AllocateSQL & SQLQuery_BasicWhere
|
|
AllocateSQL = AllocateSQL & " order by c068 asc"
|
|
|
|
Set Result = Conn.Select(AllocateSQL)
|
|
|
|
If DEBUG_ON = True Then
|
|
MsgBox "SQL:" & AllocateSQL, vbOkonly, DEBUG_TITLE
|
|
|
|
AddDebugLine "Searching For Order by OrderId (Mid Table).." & vbNewline & vbNewline
|
|
AddDebugLine "Result Columns: " & Result & vbNewline
|
|
AddDebugLine "Result Rows: " & Result.RowCount & vbNewline
|
|
AddDebugLine "AllocateSQL: " & AllocateSQL
|
|
|
|
ShowDebugBox "AllocatePseudoSerialNumbers"
|
|
End If
|
|
|
|
Dim PseudoArrayInternal()
|
|
PseudoArrayIndex = 0
|
|
Redim PseudoArrayInternal(AmountToAllocate)
|
|
|
|
If Result.RowCount < AmountToAllocate Then
|
|
Msgbox "Für Artikel " & ArtikelNr & " konnten nicht genug Pseudo-SN reserviert werden!", vbExclamation, DEFAULT_TITLE & " - AllocatePseudoSerialNumbers"
|
|
|
|
PseudoArrayInternal(0) = ""
|
|
AllocatePseudoSerialNumbers = PseudoArrayInternal
|
|
Exit Function
|
|
End If
|
|
|
|
Do: Do
|
|
|
|
PseudoSN = Result.Value("c068")
|
|
PseudoArrayInternal(PseudoArrayIndex) = PseudoSN
|
|
PseudoArrayIndex = PseudoArrayIndex + 1
|
|
|
|
InsertPacktischHistoryRow AuftragsNr, ArtikelNr, PseudoSN
|
|
Loop While False: Loop While Result.NextRecord = True
|
|
|
|
AllocatePseudoSerialNumbers = PseudoArrayInternal
|
|
End Function
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|