✔ VBA Abbrechen, Wiederholen, Ignorieren

[mamuc]

Hallo Zusammen,

ich hab folgendes Problem.
Ich hab ein Programm, dass Namen aus einer Tabelle in der einen Datenbank ausließt um diese Tabellen aus der anderen AccessDB zu verlinken.

Jetzt möchte ich beim Errorhandling folgendes haben.

Bei meiner Fehlermeldung (z.B) ......----> siehe ganz unten




Dass er bei Abbrechen das Programm beendet
bei Wiederholen es noch einmal versucht
und bei Ignorieren einfach weitermacht

wie stell ich das bei meinem code an?



Option Compare Database
Option Explicit

Dim dbsCurrent As DAO.Database
Dim dbsForeign As DAO.Database
Dim rst As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim tdf As DAO.TableDef
Dim str As String
Dim strtabn As String
Dim strPfad As String

Dim TableExists As Boolean



Sub mod_Tabellenverlinkung()

On Error GoTo ErrorHandler

' Datenbanken öffnen
Set dbsCurrent = CurrentDb
Set dbsForeign = OpenDatabase("DATABASEtwo.mdb")
Set qdf = dbsCurrent.QueryDefs("abfTabellen_Pfad")
Set rst = qdf.OpenRecordset

rst.MoveFirst


' Solange nicht End of File ist
Do While Not rst.EOF

Debug.Print "Tabellename: " & rst!TabName
Debug.Print "Pfad ="; rst!Pfad

strtabn = rst!TabName
strPfad = rst!Pfad

' Festlegen der Tabellenexistenz
For Each tdf In CurrentDb.TableDefs
If DCount("*", "MSysObjects", "Name='" & strtabn & "'") Then
TableExists = True
Else
TableExists = False
End If

' Abfrage ob Tabelle vorhanden, löschen-verlinken bzw. verlinken
If TableExists = True Then
DoCmd.DeleteObject acTable, strtabn
DoCmd.TransferDatabase acLink, "Microsoft Access", strPfad, acTable, strtabn, strtabn
Else
DoCmd.TransferDatabase acLink, "Microsoft Access", strPfad, acTable, strtabn, strtabn
End If

Next

' Nächster Datensatz
rst.MoveNext

Loop

ErrorHandler:

If Err.Number <> 0 Then

Dim Mldg, Stil, Titel, Hilfe, Text, Antwort, Text1

Titel = "Fehler!"
Stil = vbAbortRetryIgnore + vbCritical ' Schaltflächen
Dim wrlz As String
wrlz = (Chr(10))
Text = "Klicken Sie auf Abbrechen um das Programm zu beenden."

Mldg = "Laufzeitfhler: " & Err.Number & wrlz & wrlz & Err.Description & wrlz & wrlz & Text



Antwort = MsgBox(Mldg, Stil, Titel)
If Antwort = vbAbort Then ' Benutzer hat "Abbrechen" gewählt.
Text1 = "Beenden"





ElseIf Antwort = vbRetry Then ' Benutzer hat "Wiederholen" gewählt.
Text1 = "Wiederholen"


Else ' Benutzer hat "Ignorieren" gewählt.
Text1 = "Ignorieren"

End If


End If



End Sub


Liebe Grüße

mamuc

 

[larryson]

Hallo,

als erstes solltes Du diese Fehlerroutine auch nur auf entsprecchenden Fehler anwenden.

z.B.

SELECT CASE err.number
err.number=3011
'genialer Code
err.number=3021
'genialer Code
End SELECT

Die drei entsprechenden Bedingungen würden lauten:
Abbrechen=Exit Sub 'bricht den kompletten Code ab
Wiederholen=Resume 'macht in der Fehlerauslösenden Zeile weiter
Ignorieren=Resume Next 'übergeht den Fehler und macht in der nächsten Zeile weiter

 

[mamuc]

Hallo larryson,

erstmal vielen Dank, du hast mir echt geholfen, ich habs jetz aber irgendwie a bissal anders gemacht....

ErrorHandler:
If Err.Number <> 0 Then

Dim Mldg, Stil, Titel, Hilfe, Antwort, Text1

Titel = "Fehler!"
Stil = vbRetryCancel + vbCritical ' Schaltflächen
Dim wrlz As String
wrlz = (Chr(10))

Mldg = "Laufzeitfhler: " & Err.Number & wrlz & wrlz & Err.Description & wrlz & wrlz & "Klicken Sie auf Abbrechen um das Programm zu beenden" & wrlz & "Klicken Sie auf Wiederholen um mit dem Programm fortzufahren"

Antwort = MsgBox(Mldg, Stil, Titel)
If Antwort = vbCancel Then ' Benutzer hat "Abbrechen" gewählt.
Text1 = "Abbrechen"
Exit Sub

ElseIf Antwort = vbRetry Then ' Benutzer hat "Wiederholen gewählt.
Text1 = "Fortfahren"
rst.MoveNext
GoTo Zeile1

End If

End If


Du hast nicht zufällig ne Ahnung, wie ich das anstell, dass meine Schaltflächen in der MsgBox nicht wie vordefiniert z. B. Abbruch sonder Beenden heißen? oder anstatt von Wiederholen, Fortfahren?

Würd mir super viel helfen, wenn du mir sagen könntest ob und wenn ja wie ich sie umbenennen könnte.

Vielen Dank nochmal,

Liebe Grüße

mamuc

 

[larryson]

Check this

 

[mamuc]

cewl
thx