Hallo,
ich lese die Dateinamen von Zeichnungen aus einer Netzwerk-Verzeichnisstruktur aus und schreibe den Dateinamen und den Pfad in eine Tabelle. Dann lese ich aus dem Dateinamen eine Materialnummer aus und trage diese in ein weiteres Feld ein. Das ist dann zwar ein redundantes Feld aber da die Syntax Dateinamen variiert, will ich wissen, ob das Auslesen der Nummer korrekt ist.
Es gibt aber ein FK-Feld in der Tabelle, welches ich mit einer Prozedur aus der tbl_Material auslese. Es geht um etwa 22.000 Zeichnungen für etwa 18.000 Materialien.
Zuerst habe ich dann in einer Schleife bei jedem Zeichnungsdatensatz in der Materialtabelle nach Übereinstimmungen gesucht, was natürlich einiges an Zeit in Anspruch genommen hat. Später bin ich dann dazu übergegangen, sowohl die Zeichnungs- als auch die Materialtabelle in ein jeweils ein Array einzulesen und diese dann zu vergleichen. Danach dann das modifizierte Zeichnungsarray zurück in die Tabelle.
Das hat soweit auch funktioniert.
Nun habe ich das Einlesen der Dateien mittels KI umgebaut und somit die Einlesezeit von etwa 80 auf 6 Minuten reduziert. In dem Zuge habe ich auch den Vergleich mal analysieren lassen und man schlug mir den Einsatz von einem Dictionary vor.
Private Function LadeMaterialDikt() As Scripting.Dictionary
On Error GoTo Fehler
Dim rs As DAO.Recordset
Dim dict As Object
Dim MNr As String
Dim ID As Long
Set dict = CreateObject("Scripting.Dictionary")
Set rs = CurrentDb.OpenRecordset("SELECT Artikel_ID, MaterialNummer FROM tbl_Material", dbOpenSnapshot)
Do Until rs.EOF
MNr = rs!Materialnummer
ID = rs!Artikel_ID
If Not dict.Exists(MNr) Then dict.Add MNr, ID
rs.MoveNext
Loop
Set LadeMaterialDikt = dict
Ende:
On Error Resume Next
rs.Close
Set rs = Nothing
Set dict = Nothing
End Function
Der Vergleich sieht dann so aus:
Public Sub Zeich2Mat1()
Dim MatDikt As Scripting.Dictionary
Dim cDB As DAO.Database
Dim rs As DAO.Recordset
Dim MNr As String
Dim b As Long
Dim MatID As Long
Set MatDikt = LadeMaterialDikt()
Set cDB = CurrentDb
Set rs = cDB.OpenRecordset("SELECT FS_MatID, MatNR " _
& "FROM tbl_Zeichnung_LCL " _
& "WHERE MatNr <> '0'", dbOpenDynaset, dbOptimistic)
DBEngine.BeginTrans
Do Until rs.EOF
MNr = Nz(rs!MatNr, "0")
If MNr <> "0" Then
b = b + 1
rs.Edit
If MatDikt.Exists(MNr) Then
rs!FS_MatID = MatDikt(MNr)
Else
MatID = NeuMaterial(MNr, rs!Dateiname)
MatDikt.Add MNr, MatID
End If
rs.Update
End If
If b > 1 And b Mod 1000 = 0 Then 'Unterbrechnung der Schleife weil sonst Speicher voll
DBEngine.CommitTrans
DBEngine.BeginTrans
DBEngine.Idle dbRefreshCache
End If
rs.MoveNext
Loop
DBEngine.CommitTrans
Ende:
On Error Resume Next
rs.Close
Set rs = Nothing
Set MatDikt = Nothing
Debug.Print Now, "Zeich2Mat abgeschlossen"
End Sub
Das funktioniert so weit gut und ist auch echt flott. Was leider nicht funktioniert ist, wenn es Zeichnungen gibt, für die es in der Materialtabelle keine Entsprechnung gibt.
Der Plan ist, dass das Material in einer Funktion in die Tabelle eingefügt wird und dann die ID des neuen Datensatzes zurückgibt:
Public Function NeuMaterial(MatNr As String, MatBez As String) As Long
On Error GoTo Fehler
Dim cDB As DAO.Database
Dim rs As DAO.Recordset
Dim MName As String
Dim ID As Long
Set cDB = CurrentDb
MName = "AutoEingabe_" & MatBez
Set rs = cDB.OpenRecordset("SELECT Materialnummer, Bezeichnung FROM tbl_Material")
rs.AddNew
rs!Materialnummer = MatNr
rs!Bezeichnung = MName
rs.Update
rs.Close
' cDB.Execute "INSERT INTO tbl_Material (Materialnummer, Bezeichnung) " _
' & "VALUES('" & MatNr _
' & "', '" & MName & "')", dbFailOnError
ID = Nz(DLookup("Artikel_ID", "tbl_Material", "Materialnummer = '" & MatNr _
& "' AND Bezeichnung = '" & MName & "'"), 0)
If ID > 0 Then
Debug.Print Now, "Neumaterial " & MatNr, ID
cDB.Execute "UPDATE tbl_Material SET RefID = " & ID & " WHERE Artikel_ID = " & ID
cDB.Execute "INSERT INTO tbl_Index(FS_Mat, IX) VALUES (" & ID & ", 0)"
NeuMaterial = ID
DoEvents
Else
MsgBox "Keine ID gefunden"
End If
Ende:
rs.Close
Set rs = Nothing
cDB.Close
Set cDB = Nothing
end function Ursprünglich habe ich es mit dem (jetzt auskommentierten) SQL-Ausdruck versucht, dann mit rs.Addnew, aber beide Male verweigert mir die Tabelle einen Neueintrag.
Ich bin verwirrt, denn eigentlich gehören beide Prozeduren zum kleinen 1x1, die Weigerung kenne ich nicht. Das einzige was anders ist als sonst, ist der/das Dictionary. Wird die Tabelle dadurch blockiert oder welchen meiner Fehler sehe ich nicht?
Gruß
Doming
Zitat von: Doming am August 03, 2026, 12:36:26Ursprünglich habe ich es mit dem (jetzt auskommentierten) SQL-Ausdruck versucht, dann mit rs.Addnew, aber beide Male verweigert mir die Tabelle einen Neueintrag.
Was genau bedeutet "verweigert mir die Tabelle einen Neueintrag"?
Da gibt es vermutlich eine Fehlermeldung.
Wie lautet diese Fehlermeldung genau?Das Dictionary hat sicherlich nichts damit zu tun, dass du nicht in die Tabelle schreiben kannst.
Hallo,
ZitatDa gibt es vermutlich eine Fehlermeldung.
Tja, dann wäre ich weiter. Das einige was passiert, ist die MsgBox "Keine ID gefunden"
Egal ob ich den Code so wie oben lasse oder den SQL-String abschicke.
MName = "AutoEingabe_" & MatBez
' Set rs = cDB.OpenRecordset("SELECT Materialnummer, Bezeichnung FROM tbl_Material")
' rs.AddNew
' rs!Materialnummer = MatNr
' rs!Bezeichnung = MName
' rs.Update
'
' rs.Close
cDB.Execute "INSERT INTO tbl_Material (Materialnummer, Bezeichnung) " _
& "VALUES('" & MatNr _
& "', '" & MName & "')", dbFailOnError
ID = Nz(DLookup("Artikel_ID", "tbl_Material", "Materialnummer = '" & MatNr _
& "' AND Bezeichnung = '" & MName & "'"), 0)Gerade habe ich mir den SQL-String im Direktfenster anzeigen lassen. Setze ich ein currentDB.Execute davor, wird das Material angelegt (ohne laufenden Code, also nicht im Unterbrechungsmodus).
In der Tabelle ist nur bei der Artikel_ID und der Bezeichnung eine Eingabe erforderlich.
Rufe ich im Direktfenster die Funktion auf (?Neumaterial("1234.12.1234", "Kannweg") wird mir sofort die neue ID ausgegeben.
kein "On Error Resume Next", auch im Einzelschrittmodus laufe ich so durch
Edit: Rufe ich im Unterbrechnungsmodus (da, wo er gerade vergeblich versucht hat, eine ID zu finden) die Materialtabelle auf, kann ich in den Feldern Daten verändern, allerdings nicht beim letzten Datensatz.
Nur kurz vor unterwegs...
Denke.mal darüber nach was DBEngine.BeginTrans eigentlich bewirkt. ;)
Hallo Doming,
Hast du dieses Rs mal auf ".NoMatch" geprüft?
Set rs = cDB.OpenRecordset("SELECT FS_MatID, MatNR " _
& "FROM tbl_Zeichnung_LCL " _
& "WHERE MatNr <> '0'", dbOpenDynaset, dbOptimistic)
gruss ekkehard
Zitat von: Beaker s.a. am August 03, 2026, 15:42:37Hast du dieses Rs mal auf ".NoMatch" geprüft?
?
Recordset.NoMatch hat meines Wissens nur in Verbindung mit Recordset.Seek/.Find... eine dokumentierte Funktion.