Public Sub createCharges()
Dim db As DAO.Database
Dim rs As DAO.Recordset, rs1 As DAO.Recordset
Dim lngAnzahl As Long
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT * FROM Fertigungsaufträge WHERE erledigt = 0;")
If rs.RecordCount = 0 Then
MsgBox "Keine zu bearbeitenden Lieferungen gefunden.", vbInformation
GoTo cleanUp
End If
Do While Not rs.EOF
Set rs1 = db.OpenRecordset("SELECT Verpackungsmenge FROM Artikelstammdaten WHERE Artikelnummer = '" & rs.Fields("Artikelnummer") & "';")
If rs1.RecordCount = 0 Then
MsgBox "Zur Lieferung" & vbCrLf & vbCrLf & _
rs.Fields("ID") & " | " & rs.Fields("Artikelnummer") & " | " & rs.Fields("Menge") & " | " & rs.Fields("Chargennummer") & vbCrLf & vbCrLf & _
"wurden keine Stammdaten gefunden.", vbInformation, "Überspringe Lieferung"
GoTo cleanUp
Else
Dim lngMenge As Long
Dim lngVerpackungsmenge As Long
Dim lngCount As Long
lngMenge = rs.Fields("Menge")
lngVerpackungsmenge = rs1.Fields("Verpackungsmenge")
Do While lngMenge > 0
Select Case lngMenge
Case Is >= lngVerpackungsmenge
db.Execute ("INSERT INTO Chargen (Artikelnummer, Menge) VALUES ('" & rs.Fields("Artikelnummer") & "', " & lngVerpackungsmenge & ");")
Case Is < lngVerpackungsmenge
db.Execute ("INSERT INTO Chargen (Artikelnummer, Menge) VALUES ('" & rs.Fields("Artikelnummer") & "', " & lngMenge & ");")
End Select
lngCount = lngCount + 1
lngMenge = lngMenge - lngVerpackungsmenge
Loop
End If
db.Execute ("UPDATE Fertigungsaufträge SET erledigt = -1 WHERE ID = " & rs.Fields("ID") & ";")
rs.MoveNext
Loop
MsgBox "Verarbeitung erfolgreich, es wurden " & lngCount & " Chargen erstellt.", vbInformation
cleanUp:
If Not rs1 Is Nothing Then Set rs1 = Nothing
If Not rs Is Nothing Then Set rs = Nothing
If Not db Is Nothing Then Set db = Nothing
End Sub