Member
Beiträge: 41
| Hallo Karl,
hier der exakte Code, ich verwende das ähnlich dieser Form schon seit ewig:
Dim db As DAO.Database
Dim daten As String
Dim i As Integer
Dim fd As New FileDialog
Dim dname As String
Dim pfad As String
Dim selberOrdner As Boolean
Dim fs As Object
Set db = CurrentDb
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.FileExists(Mid(db.TableDefs(0).Connect, 11)) Then
If Not fs.FileExists(Left(db.Name, Len(db.Name) - Len(Dir(db.Name))) & "Daten.mdb") Then
MsgBox "Die Datei Daten.mdb wurde nicht gefunden, klicken Sie auf OK um den Pfad anzugeben.", vbCritical, "Datei nicht gefunden!"
fd.DefaultDir = "c:\"
fd.Filter1Text = "Datenbanken"
fd.Filter1Suffix = "*.mdb"
fd.ShowOpen
If fd.FileName = "" Then
MsgBox "Sie haben keine gültige Datenbankdatei angegeben, die Anwendung wird beendet", vbCritical, "Ungültige Datenbank!"
DoCmd.Quit
End If
daten = fd.FileName
Else
daten = Left(db.Name, Len(db.Name) - Len(Dir(db.Name))) & "Daten.mdb"
End If
If Right(daten, 9) <> "Daten.mdb" Then
MsgBox "Sie haben keine gültige Datenbankdatei angegeben, die Anwendung wird beendet", vbCritical, "Ungültige Datenbank!"
DoCmd.Quit
End If
If fs.FileExists(Left(daten, Len(daten) - 4) & ".ldb") Then
If MsgBox("Das Kundenverwaltungsprogramm scheint auf einem Arbeitsplatz geöffnet zu sein, wenn sie fortfahren kann der Vorgang länger dauern!", vbInformation + vbOKCancel, "Hinweis!") = vbOK Then
For i = 0 To db.TableDefs.count - 1
If db.TableDefs(i).Connect <> "" Then
If Mid(db.TableDefs(i).Connect, 11) <> daten Then
db.TableDefs(i).Connect = ";database=" & daten
db.TableDefs(i).RefreshLink
End If
End If
Next i
Else
MsgBox "Sie haben keine gültige Datenbankdatei angegeben, die Anwendung wird beendet", vbCritical, "Ungültige Datenbank!"
DoCmd.Quit
End If
Else
For i = 0 To db.TableDefs.count - 1
If db.TableDefs(i).Connect <> "" Then
If Mid(db.TableDefs(i).Connect, 11) <> daten Then
db.TableDefs(i).Connect = ";database=" & daten
db.TableDefs(i).RefreshLink
End If
End If
Next i
End If
End If
|