Supportnet / Forum / Datenbanken

Hallo Ich arbeite erst seit einigen Tagen mit Acces und habe folgende Aufgabe zu lösen : Schlaufe zum Durchlaufen aller Records in "T_Artikel", Artikelnbr einlesen und in T_ArtShop nach gleicher ArbNbr suchen (Schlaufe), wenn, wenn Nbr gefunden dann Felder mit Text einlesen. Folgendes habe ich probiert, leider ohne Erfolg : Function PutProfiToASBeschrieb() On Error Resume Next gRetVal = -1 Dim ws As Workspace Dim DB1 As Database Dim DB2 As Database Dim ProfiBeschrieb As Recordset Dim ASBeschrieb As Recordset Dim MsgStatusTemp As Integer Dim i As Integer Dim x As Variant Dim ProfiArtNrTmp As String Dim ASArtNrTmp As String Dim KatNrTmp As String Dim NewRecordCount As Long Dim EditedRecordCount As Long Set ws = DBEngine.Workspaces(0) Set DB1 = CurrentDb Set DB2 = CurrentDb Set ASBeschrieb = DB1.OpenRecordset("T_Artikel", DB_OPEN_DYNASET) Set ProfiBeschrieb = DB2.OpenRecordset("T_ArtShop", DB_OPEN_DYNASET) NewRecordCount = 0 EditedRecordCount = 0 Hinweis und Möglichkeit zum Abbruch x = MsgBox("Diese Funktion arbeitet nicht direkt mit Profitex." & Chr(13) & "Ich hoffe es funktioniert" & Chr(13) & Chr(13) & "Viel Spass beim warten !!", 305, PTITLE) If x = 2 Then GoTo PutProfiToASBeschriebExit: DoCmd.Hourglass True ws.BeginTrans ProfiBeschrieb.MoveFirst Do While Not (ProfiBeschrieb.EOF) ASArtNrTmp = ASBeschrieb("ArtikelNr") ASBeschrieb.MoveFirst Suchen eines gleichen Records in ASBeschrieb und erneuern Do While Not (ASBeschrieb.EOF) ProfiArtNrTmp = ProfiBeschrieb("ArtNbr") Bei True bestehender Art erneuern If ProfiArtNrTmp = ASArtNrTmp Then ASBeschrieb.Edit ASBeschrieb.AddNew ASBeschrieb("Beschrieb") = ProfiBeschrieb("Feld2") ASBeschrieb.Update EditedRecordCount = EditedRecordCount + 1 Exit Do End If ASBeschrieb.MoveNext Loop bei True Profitex Artikel in ASBeschrieb neu hinzufügen mit Standardfaktoren If ASBeschrieb.EOF = True Then ASBeschrieb.Edit ASBeschrieb.AddNew ASBeschrieb("Beschrieb") = ProfiBeschrieb("Feld2") ASBeschrieb.Update NewRecordCount = NewRecordCount + 1 End If ProfiBeschrieb.MoveNext Loop ws.CommitTrans ProfiBeschrieb.Close ASBeschrieb.Close GoTo PutProfiToASBeschriebExit PutProfiToASBeschriebExit: DoCmd.Hourglass False MsgBox "Es wurden " & EditedRecordCount & " bestehende Artikel mutiert, und " & Chr(13) & NewRecordCount & " Artikel aus Profitex neu hinzugefügt.", 48, INFOTITLE PutProfiToASBeschrieb = gRetVal Exit Function PutProfiToASBeschriebErr: On Error Resume Next ws.Rollback ProfiBeschrieb.Close ASBeschrieb.Close gRetVal = 0 MsgBox Error$, 48, ERTITLE Resume PutProfiToASBeschriebExit End Function Kann mir bitte jemand sagen, was ich falsch mache. Ich bin kurz vor dem verzweifeln. Besten Dank und Gruss aus der Schweiz Sabine

Hallo Sabine, ich habe Deinen Code durchgesehen und einiges mit Kommentar versehen. Mit diesen Änderungen sollte es klappen.

Function PutProfiToASBeschrieb()

On Error Resume Next
gRetVal = -1

Dim ws As Workspace
Dim DB1 As Database
-- eigentlich überflüssig s.u.
Dim DB2 As Database
Dim ProfiBeschrieb As Recordset
Dim ASBeschrieb As Recordset

Dim MsgStatusTemp As Integer
Dim i As Integer
Dim x As Variant

Dim ProfiArtNrTmp As String
Dim ASArtNrTmp As String
Dim KatNrTmp As String
Dim NewRecordCount As Long
Dim EditedRecordCount As Long

Set ws = DBEngine.Workspaces(0)
Set DB1 = CurrentDb
-- ist eigentlich überflüssig.
Set DB2 = CurrentDb

Set ASBeschrieb = DB1.OpenRecordset("T_Artikel", DB_OPEN_DYNASET)
-- hier kannst Du auch DB1.OpenRecordset... sagen. Spart Speicher :-)
Set ProfiBeschrieb = DB2.OpenRecordset("T_ArtShop", DB_OPEN_DYNASET)

NewRecordCount = 0
EditedRecordCount = 0

--Hinweis und Möglichkeit zum Abbruch
x = MsgBox("Diese Funktion arbeitet nicht direkt mit Profitex." & Chr(13) & "Ich hoffe es funktioniert" & Chr(13) & Chr(13) & "Viel Spass beim warten !!", 305, PTITLE)
If x = 2 Then GoTo PutProfiToASBeschriebExit:

DoCmd.Hourglass True
ws.BeginTrans

ProfiBeschrieb.MoveFirst

Do While Not (ProfiBeschrieb.EOF)
-- 1. Reihenfolge erst Movefirst
-- 2. ansprechen eines Feldinhalts: ASBeschrieb!ArtikelNr
ASArtNrTmp = ASBeschrieb("ArtikelNr")

ASBeschrieb.MoveFirst
--Suchen eines gleichen Records in ASBeschrieb und erneuern
Do While Not (ASBeschrieb.EOF)
-- s.o. ProfiBeschrieb!ArtNbr
ProfiArtNrTmp = ProfiBeschrieb("ArtNbr")
--Bei True bestehender Art erneuern
If ProfiArtNrTmp = ASArtNrTmp Then
-- entweder .Edit wenn Daten verändert werden sollen oder
-- .AddNew wenn ein neuer Datensatz hinzugefügt werden soll
ASBeschrieb.Edit
ASBeschrieb.AddNew
-- s.o. ASBeschrieb!Beschrieb = ProfiBeschrieb!Feld2
ASBeschrieb("Beschrieb") = ProfiBeschrieb("Feld2")
ASBeschrieb.Update
EditedRecordCount = EditedRecordCount + 1
Exit Do
End If
ASBeschrieb.MoveNext
Loop
-- bei True Profitex Artikel in ASBeschrieb neu hinzufügen mit Standardfaktoren
If ASBeschrieb.EOF = True Then
-- s.o.
ASBeschrieb.Edit
ASBeschrieb.AddNew
-- s.o.
ASBeschrieb("Beschrieb") = ProfiBeschrieb("Feld2")
ASBeschrieb.Update
NewRecordCount = NewRecordCount + 1
End If
ProfiBeschrieb.MoveNext
Loop

ws.CommitTrans
ProfiBeschrieb.Close
ASBeschrieb.Close

GoTo PutProfiToASBeschriebExit

PutProfiToASBeschriebExit:
DoCmd.Hourglass False
MsgBox "Es wurden " & EditedRecordCount & " bestehende Artikel mutiert, und " & Chr(13) & NewRecordCount & " Artikel aus Profitex neu hinzugefügt.", 48, INFOTITLE
PutProfiToASBeschrieb = gRetVal
Exit Function

PutProfiToASBeschriebErr:

On Error Resume Next
ws.Rollback
ProfiBeschrieb.Close
ASBeschrieb.Close
gRetVal = 0
MsgBox Error$, 48, ERTITLE
Resume PutProfiToASBeschriebExit

End Function


Gruss Mick

• Bestandserfassung
• Access Tabellendatensatz kopieren
• laufende Nummer in unterformular
• 0x000000ED (0X81BDCE30,0xc0000185, 0x00000000,0x00000000).