Guten Tag werte Access-Profis,
so langsam muss ich mich für die Hilfe die ich von euch bekomme schämen aber ich habe mal wieder ein Problem.
Ich möchte eine Hauptverzeichnis erstellen was befüllt wird und sobald ich im Backend an die 2GB-Grenze stoße will ich das Backend kopieren umbenennen, die Daten löschen und weiter befüllen um so die alten Daten nicht zu verlieren aber auch neue aufnehmen kann.
Soweit steht die Datenbank auch aber ich habe ein Problem mit dem ändern des Backends.
Ich möchte idealerweise einen Knopf in einem Formular haben auf den ich drücke dann öffnet sich ein FileDialog in dem ich das Backend wähle. Access soll dann automatisch alle bisher eingebundenen Tabellen löschen und die neuen einbinden.
Ich habe bisher folgenden Code genutzt:
Private Sub Backendwahl_Click()
Me!Pfad = OpenFile()
End Sub
Function OpenFile() As String
Dim fso As FileDialog
Dim Datei As String
Dim Auswahl As Variant
Set fso = Application.FileDialog(msoFileDialogFilePicker) 'Art des Dialog
fso.Filters.Add "Datenbank", "*.mdb,*.accdb,*.mde", 1 'Filter setzten
fso.Title = "Office Lösung Dateidialog" 'Titel des Dialogs
fso.ButtonName = "Backendwahl" 'Button Beschriftung
fso.InitialFileName = "G:\Service\Probedatenbank\" 'Standart Pfad
fso.InitialView = msoFileDialogViewLargeIcons 'Art der Darstellung
If fso.Show = -1 Then 'Kontrolle das nicht Abbrechen
For Each Auswahl In fso.SelectedItems 'Auswahl durchlaufen
Datei = Auswahl
Next Auswahl
End If
OpenFile = Datei
Set fso = Nothing 'Set hinzugefuegt by Willi Wipp
End Function
Private Sub Backendwahl_Click()
DoCmd.DeleteObject acTable, ([tbl_Serviceverzeichnis] And [tbl_Pumpen] And [tbl_Wärmepumpen] And [tbl_Artikelliste] And [tbl_Fehlercodes])
End Sub
Private Sub Backendwahl_Click()
Dim rs As DAO.Recordset, dbPath As String
Dim bePath As String
Dim strForeignName As String
Dim strtabName As String
Set rs = CurrentDb.OpenRecordset("Select [Name] As tabName, ForeignName, Database From MsysObjects Where Type = 6")
If Not rs.EOF Then
dbPath = Left(rs!Database, Len(rs!Database) - Len(Dir(rs!Database)))
bePath = Left(CurrentDb.Name, Len(CurrentDb.Name) - Len(Dir(CurrentDb.Name)))
If dbPath <> bePath Then
MsgBox "Die Datenbank wurde auf einen anderen Pfad verschoben. " & vbCrLf & _
"Die Tabellen werden neu verknüpft"
Do While Not rs.EOF
strForeignName = rs!ForeignName
strtabName = rs!tabName
DoCmd.DeleteObject acTable, rs!tabName
DoCmd.TransferDatabase acLink, "Microsoft Access", _
bePath & "*.accdb", strForeignName, strtabName
rs.MoveNext
Loop
End If
Else
MsgBox "Es gibt keine eingebundenen Tabellen"
End If
rs.Close
End Sub
Wenn ich nun auf den Button klicke bekomme ich eine Fehlermeldung das die Ereignisprozedur Beim Klicken einen Fehler verursacht.
Ich habe den FileDialog auch mal ohne den Rest getestet und hier öffnet er mir einen Entsprechenden Dialog in dem ich die Backends wählen kann allerdings bekomme ich wenn ich die Wahl bestätige wieder eine Fehlermeldung.
Mit freundlichen Grüßen
Churian
Hallo,
ZitatDoCmd.DeleteObject acTable, ([tbl_Serviceverzeichnis] And [tbl_Pumpen] And [tbl_Wärmepumpen] And [tbl_Artikelliste] And [tbl_Fehlercodes])
schau dazu mal in der VBA-Hilfe nach....
zudem gibt es 2 Subs "Backendwahl_Click()"
Also ich verwende auch mehrere Backends mit "Massendaten" für das Billing. Dafür werden monatlich verschiedene Tabellen erstellt. Je nach Bedarf erzeuge ich dann weitere Access Dateien mit den entsprechenden Tabellen.
Für die Anzeige im Formular verwende ich dann als Datenbasis ein Recordset um die gewünschte Tabelle anzuzeigen. LG Markus
Übrigens kommt in deinem Code "Private Sub Backendwahl_Click()" dreimal vor. Das kann nicht funktionieren.
Upps, ich werde alt...
und kann nicht mal mehr bis 3 zählen... :'( :o ??? :(
Hi,
Zitat von: DF6GL am Juli 09, 2015, 13:46:05zudem gibt es 2 Subs "Backendwahl_Click()"
tatsächlich sind es sogar drei! ;-)
Führe also den Code aus den drei Prozeduren in der richtigen Reihenfolge zu einer zusammen.
Nach dem Löschen der Tabellen funktioniert allerdings der Code des dritten Parts nicht mehr, das solltest du also weglassen. Und dann solltest du dort auch den ausgewählten Pfad zum neuen Backend verwenden.
Das mit den 3 on click-Ereignissen war auch selten dämlich.... :-[
Ich schiebs jetzt einfach mal auf den nahenden Feierabend ;)
Besser erstmal eins nach dem anderen. Ich habe den Code etwas verändert und den Teil mit der Neuverknüpfung der Tabellen erstmal raus gelassen.
Private Sub Action_Click()
DoCmd.DeleteObject acTable, "tbl_Tabelle1"
DoCmd.DeleteObject acTable, "tbl_Tabelle2"
DoCmd.DeleteObject acTable, "tbl_Tabelle3"
[...]
Call OpenFile
End Sub
Function OpenFile() As String
Dim fso As FileDialog
Dim Datei As String
Dim Auswahl As Variant
Set fso = Application.FileDialog(msoFileDialogFilePicker)
fso.Filters.Add "Datenbank", "*.mdb,*.accdb,*.mde", 1
fso.Title = "Office Lösung Dateidialog"
fso.ButtonName = "Backendwahl"
fso.InitialFileName = "G:\Service\Probedatenbank\"
fso.InitialView = msoFileDialogViewLargeIcons
If fso.Show = -1 Then
For Each Auswahl In fso.SelectedItems
Datei = Auswahl
Next Auswahl
End If
OpenFile = Datei
Set fso = Nothing
End Function
Funktionieren tut der Teil mit dem löschen der Tabellen schonmal ich kann aber noch nicht sagen ob der FileDialog auch korrekt funktioniert. Der Code zum Lösen der Tabellen ist nicht sehr schön. Sollte der Button 2 mal gedrückt werden oder eine der Tabellen manuell gelöscht werden bekommt man eine Fehlermeldung und variabel ist das auch nicht.
Ich habe noch einen zweiten Code zum Löschen der Tabellen gefunden:
Sub TabellenLöschen()
' Verweis auf Microsof DAO
Dim db As DAO.Database
Dim i As Integer
Set db = CurrentDb
For i = 0 To db.TableDefs.Count - 1
'Debug.Print db.TableDefs(i).Name, db.TableDefs(i).Attributes
If db.TableDefs(i).Attributes = 0 Then
If InStr(db.TableDefs(i).Name, "tbl_") Then
Debug.Print db.TableDefs(i).Name
DoCmd.DeleteObject acTable, db.TableDefs(i).Name
End If
End If
Next i
End Sub
ich hatte gedacht ich könnte so alle Tabellen die "tbl_" im Namen haben (was bei meiner Nomenklatur alle sind) löschen aber wenn ich versuche die Funktion mittels Call TabellenLöschen passiert gar nichts. Ausser das sich der FileDialog öffnet. Die Tabellen bleiben also bestehen.
Ich habe die DAO Library aktiviert.
Liebe Grüße und Danke an alle die mir versuchen zu helfen.
Hi,
Zitatpassiert gar nichts
die 0 ist kein gültiger
Attributes-Wert, kann also nicht gefunden werden.
Nach was willst du denn da suchen?
Außerdem sollte man Löschschleifen immer rückwärts laufen lassen.
Versuche es mal hiermit:
For i = db.TableDefs.Count - 1 To 0 Step -1
'Debug.Print db.TableDefs(i).Name, db.TableDefs(i).Attributes
'If db.TableDefs(i).Attributes = 0 Then
If Left(db.TableDefs(i).Name, 4) = "tbl_" Then
Debug.Print db.TableDefs(i).Name
DoCmd.DeleteObject acTable, db.TableDefs(i).Name
End If
'End If
Next i
Hi,
der Code funktioniert toll.
Warum sollte man Löschschleifen immer rückwärts laufen lassen?
ZitatNach was willst du denn da suchen?
Auf was bezieht sich deine Frage?
Der Code für die Neuverknüpfung ist mir noch sehr schleierhaft was er genau tut ich habe das so verstanden das hier die Tabellen vom Backend aus neu eingebunden werden aber ich finde keine Bezüge zu dem FileDialog. Irgendwoher muss der Befehl ja wissen welche Backend Datei er nehmen muss.
Public Function LinkTables()
Dim rs As DAO.Recordset, dbPath As String
Dim bePath As String
Dim strForeignName As String
Dim strtabName As String
Set rs = CurrentDb.OpenRecordset("Select [Name] As tabName, ForeignName, Database From MsysObjects Where Type = 6")
If Not rs.EOF Then
dbPath = Left(rs!Database, Len(rs!Database) - Len(Dir(rs!Database)))
bePath = Left(CurrentDb.Name, Len(CurrentDb.Name) - Len(Dir(CurrentDb.Name)))
If dbPath <> bePath Then
MsgBox "Die Datenbank wurde auf einen anderen Pfad verschoben. " & vbCrLf & _
"Die Tabellen werden neu verknüpft"
Do While Not rs.EOF
strForeignName = rs!ForeignName
strtabName = rs!tabName
DoCmd.DeleteObject acTable, rs!tabName
DoCmd.TransferDatabase acLink, "Microsoft Access", _
bePath & "*.accdb", strForeignName, strtabName
rs.MoveNext
Loop
End If
Else
MsgBox "Es gibt keine eingebundenen Tabellen"
End If
rs.Close
End Function
Der Code wird über eine Call-Anweisung am ende der OpenFile-Prozedur gestartet.
Wenn ich den Code nun ausführe bekomme ich nur das Pop-up das es keine eingebundenen Tabellen gibt.
Habe ich schlicht einen Code ausgesucht der etwas völlig anderes tut als ich das beabsichtige?
Mit freundlichen Grüßen
Churian
Hi,
ZitatWarum sollte man Löschschleifen immer rückwärts laufen lassen?
weil man ihn sonst mehrfach ausführen muss bis alle Objekte gelöscht sind, da der Index durch die Löschung Sprünge macht.
...oder verwechsle ich da grad was? ???
ZitatAuf was bezieht sich deine Frage?
Auf diese Code-Zeile:
'If db.TableDefs(i).Attributes = 0 ThenNach welchen Attributen willst du da suchen? Wo hast du das her?
Nachtrag: Sorry, alles OK, ich hatte mir nur die Auflistung der "TableDefAttributeEnums" angesehen und den Hinweis "Der Standardwert ist 0" übersehen.
Was das Einbinden betrifft so funktioniert der Code nicht, wenn du die Tabellen vorher löschst, weil nicht mehr festgestellt werden kann, welche Tabellen überhaupt eingebunden werden sollen.
Zitataber ich finde keine Bezüge zu dem FileDialog
Der Code setzt voraus, dass sich das Backend im selben Ordner befindet wie das Frontend.
Hey,
Zitatweil man ihn sonst mehrfach ausführen muss bis alle Objekte gelöscht sind, da der Index durch die Löschung Sprünge macht.
Ok. Ich dachte das Programm zählt so lange weiter bis alle Elemente gelöscht sind.
Sollte ich die Einbindung lieber über mehrere DoCmd.TransferDatabase-Funktion machen?
DoCmd.TransferDatabase acImport, "Microsoft Access", _
"Auswahl", acTable, "Tabelle1"
DoCmd.TransferDatabase acImport, "Microsoft Access", _
"Auswahl", acTable, "Tabelle2"
sowas in der Art?
Grüße
Churian
Du musst zunächst einmal festlegen, was genau du vorhast. Soll das Backend von einem beliebigen Speicherort eingebunden werden können, dann brauchst du einen FileDialog. Dann kannst du entweder alle Tabellen aus dem Backend einbinden oder du schreibst die Namen der zu verknüpfenden Tabellen in eine Frontend-Tabelle und arbeitest diese in einer Schleife ab. Oder du löschst die Tabellen einfach nicht bevor du sie neu einbindest. Die Einbindung über einzelne TransferDatabase-Befehle ist sicherlich die schlechteste (weil unflexibelste) Lösung.
Guten Morgen,
ZitatSoll das Backend von einem beliebigen Speicherort eingebunden werden können
das ist das was ich vor habe. Ich drücke im Formular einen Knopf, der Dialog öffnet sich und ich kann wählen, die bestehenden Tabellen werden gelöscht und die neuen verknüpft.
Das einzelne TransfereDatabase-Befehle recht unschön sind hab ich mir fast gedacht. Ich würde ähnlich wie bei dem Löschvorgang, wo alle Tabellen gelöscht werden, gern alle Tabellen des neuen Backends einbinden.
Zitatdann brauchst du einen FileDialog
den habe ich ja bereits. Es öffnet sich auch ein entsprechendes Fenster und ich kann ein Backend auswählen. Den Code habe ich weiter oben schon mal gezeigt.
Könnte ich das mit einer ähnlichen Schleife lösen wie auch das Löschen?
Quasi:
Sub LinkTables()
' Verweis auf Microsof DAO
Dim db As DAO.Database
Dim i As Integer
Set db = CurrentDb
For i = db.TableDefs.Count - 1 To 0 Step -1
'Debug.Print db.TableDefs(i).Name, db.TableDefs(i).Attributes
'If db.TableDefs(i).Attributes = 0 Then
If Left(db.TableDefs(i).Name, 4) = "tbl_" Then
Debug.Print db.TableDefs(i).Name
DoCmd.TransfereDatabase acTable, db.TableDefs(i).Name
End If
'End If
Next iIch vermute das das nicht geht da ich keine Beziehung zum neuen Backend oder FileDialog habe.
Edit: Habs getestet ich bekomme einen Fehler beim Kompilieren wenn ich einfach die selbe Schleife nutze wie beim Löschen.
Mit freundlichen Grüßen
Ich hatte ja bereits darauf hingewiesen, dass du das vorhergehende Löschen unterlassen solltest. Und wenn du dir den Code zum Einbinden der Tabellen einmal genauer ansiehst, wirst du feststellen, dass dort die Tabelle vor dem erneuten Verlinken erst gelöscht wird.
Und was die Schleife über die TableDefs-Auflistung betrifft: Wenn die Tabellen gelöscht sind, wirst du da logischerweise nichts mehr finden können.
ZitatFehler beim Kompilieren
Welcher könnte das sein? ???
Hey,
Aber wenn ich die bestehenden Tabellen nicht lösche schreibt Access doch die neuen Daten nicht in ein anderes Backend oder irre ich mich?
ok dann habe ich den Einbinde-Code falsch verstanden.
Der Debugger zeigt mir den Fehler in der Zeile vom DoCmd.TransfereDatabase an.
Hast du das dort genauso falsch geschrieben wie hier oder was ist der Grund?
Die Fehlermeldung solltest du uns am besten sofort und ohne extra Nachfrage dazu liefern.
Zitatdann habe ich den Einbinde-Code falsch verstanden
Was meinst du wohl was diese Zeilen aus dem Einbinde-Code bewirken:
DoCmd.DeleteObject acTable, rs!tabName
DoCmd.TransferDatabase acLink, "Microsoft Access", _
bePath & "*.accdb", strForeignName, strtabName
Guten Morgen,
wir haben ja schon festgestellt das der ursprüngliche Einbinde-Code Schwachsinn ist. Ich verwende den auch gar nicht mehr.
Ich dachte deine letzter Post bezieht sich auf meine neuere Idee das über den Namensabgleich umzusetzten.
Ich schreibe nochmal meinen kompletten Code für den Button hier hin.
Private Sub cmd_Action_Click()
Call DelTable
Call OpenFile
End Sub
Function OpenFile() As String
Dim fso As FileDialog
Dim Datei As String
Dim Auswahl As Variant
Set fso = Application.FileDialog(msoFileDialogFilePicker)
fso.Filters.Add "Datenbank", "*.mdb,*.accdb,*.mde", 1
fso.Title = "Office Lösung Dateidialog"
fso.ButtonName = "Backendwahl"
fso.InitialFileName = "G:\Service\Probedatenbank\Backends"
fso.InitialView = msoFileDialogViewLargeIcons
If fso.Show = -1 Then
For Each Auswahl In fso.SelectedItems
Datei = Auswahl
Next Auswahl
End If
OpenFile = Datei
Set fso = Nothing
Call LinkTables
End Function
Sub DelTable()
Dim db As DAO.Database
Dim i As Integer
Set db = CurrentDb
For i = db.TableDefs.Count - 1 To 0 Step -1
'Debug.Print db.TableDefs(i).Name, db.TableDefs(i).Attributes
'If db.TableDefs(i).Attributes = 0 Then
If Left(db.TableDefs(i).Name, 4) = "tbl_" Then
Debug.Print db.TableDefs(i).Name
DoCmd.DeleteObject acTable, db.TableDefs(i).Name
End If
'End If
Next i
End Sub
Sub LinkTables()
' Verweis auf Microsof DAO
Dim db As DAO.Database
Dim i As Integer
Set db = Auswahl
For i = db.TableDefs.Count - 1 To 0 Step -1
'Debug.Print db.TableDefs(i).Name, db.TableDefs(i).Attributes
'If db.TableDefs(i).Attributes = 0 Then
If Left(db.TableDefs(i).Name, 4) = "tbl_" Then
Debug.Print db.TableDefs(i).Name
DoCmd.TransfereDatabase acTable, db.TableDefs(i).Name
End If
'End If
Next i
End Sub
Grüße
Hi,
so könnte es was werden:
' Verweis auf Microsof DAO wird benötigt
' Verweis auf Office-Bibliothek wird benötigt
Private Sub cmd_Action_Click()
Dim strDateiname As String
Call DelTables
strDateiname = OpenFile
Call LinkTables(strDateiname)
End Sub
Function OpenFile() As String
Dim fso As FileDialog
Dim Datei As String
Set fso = Application.FileDialog(msoFileDialogFilePicker)
With fso
.Filters.Add "Datenbank", "*.mdb,*.accdb,*.mde", 1
.AllowMultiSelect = False
.title = "Office Lösung Dateidialog"
.ButtonName = "Backendwahl"
.InitialFileName = "G:\Service\Probedatenbank\Backends"
.InitialView = msoFileDialogViewLargeIcons
If .Show = -1 Then
Datei = .SelectedItems(1)
End If
End With
OpenFile = Datei
Set fso = Nothing
End Function
Sub DelTables()
Dim db As DAO.Database
Dim i As Integer
Set db = CurrentDB
For i = db.TableDefs.Count - 1 To 0 Step -1
'Debug.Print db.TableDefs(i).Name, db.TableDefs(i).Attributes
If Left(db.TableDefs(i).Name, 4) = "tbl_" Then
Debug.Print db.TableDefs(i).Name
DoCmd.DeleteObject acTable, db.TableDefs(i).Name
End If
Next i
End Sub
Sub LinkTables(strBE)
Dim db As DAO.Database, td As DAO.TableDef
Dim i As Integer
Set db = DBEngine.Workspaces(0).OpenDatabase(strBE)
For Each td In db.TableDefs
If Left(db.TableDefs(i).Name, 4) = "tbl_" Then
' Debug.Print db.TableDefs(i).Name
DoCmd.TransferDatabase acLink, "Microsoft Access", strBE, acTable, db.TableDefs(i).Name
End If
Next
db.Close
Set db = Nothing
End Sub
Hey Maggie,
vorab erstmal danke für die Mühe. Ich hab den Code mal ausprobiert und er funktioniert.
Ich habe das zwischenzeitlich aber auch "selber" hin bekommen oder besser ich habe eine Datenbank gefunden die eine solche Funktion bereits hat.
In der Datenbank gab es eine Tabelle in der der Dateipfad des Backends hinterlegt ist und ein Modul und einen Button der alles auslöst.
Tabellenname: sys
Code des Knopfes:
Option Compare Database
Option Explicit
Private Sub neuButton_Click()
Dim dbx As DAO.Database
Dim tb As DAO.TableDef
Dim sBEpfad As String
sBEpfad = dateioeffnen(Application.CurrentProject.Path, "BackEnd Datenbank öffnen")
If sBEpfad <> "" And (Right(sBEpfad, 4) = ".mdb" Or Right(sBEpfad, 6) = ".accdb") Then
Set dbx = DBEngine.Workspaces(0).OpenDatabase(sBEpfad)
db_aendern (sBEpfad)
For Each tb In dbx.TableDefs()
If InStr(1, tb.Name, "MSys") = 0 Then tabcheck tb.Name, sBEpfad
Next
End If
End Sub
Code des Moduls:
Option Compare Database
Option Explicit
Function init()
Dim pfad As String
Dim dbx As DAO.Database
Dim rs As DAO.Recordset
Dim t As DAO.TableDef
Dim sBEPath As String
On Error GoTo init_err
Set rs = CurrentDb.OpenRecordset("sys")
If rs.EOF Then
MsgBox "Kein Datensatz in der Tabelle 'sys'", vbCritical, "Hoppla"
rs.AddNew
rs!dbnam = "dummy"
rs.Update
End If
Do While Not rs.EOF
sBEPath = rs!dbnam
If InStr(1, sBEPath, "\") = 0 Then
pfad = Application.CurrentProject.Path & "\" & sBEPath
Else
pfad = sBEPath
End If
Set dbx = DBEngine.Workspaces(0).OpenDatabase(pfad)
For Each t In dbx.TableDefs()
If InStr(1, t.Name, "MSys") = 0 Then tabcheck t.Name, pfad
Next
rs.MoveNext
Loop
rs.Close
init_exit:
Set dbx = Nothing
On Error GoTo 0
Exit Function
init_err:
If Err.Number = 3024 Or Err.Number = 3044 Or Err.Number = 3043 Then
pfad = dateioeffnen(Application.CurrentProject.Path, "BackEnd Datenbank öffnen")
If pfad <> "" Then
db_aendern (pfad)
Else
Application.Quit
End If
ElseIf Err.Number = 3059 Then
Application.Quit
ElseIf Err.Number = 94 Then
MsgBox "Kein Dateiname im Feld 'sys.dbname'", vbCritical, "Hoppla"
rs.Edit
rs!dbnam = "dummy"
rs.Update
ElseIf Err.Number = 3078 Then
MsgBox "Keine Tabelle 'sys' vorhanden", vbCritical, "Hoppla"
CurrentDb.Execute "SELECT 'dummy' AS dbnam INTO sys;"
Else
MsgBox "Fehler: " & Err.Number & " - " & Err.Description
Stop
End If
Resume
End Function
Sub tabcheck(tabnam As String, quelle As String)
Dim rs As DAO.Recordset
On Error GoTo tabcheck_err
Set rs = CurrentDb.OpenRecordset(tabnam)
rs.Close
tabcheck_exit:
On Error GoTo 0
Exit Sub
tabcheck_err:
If Err.Number = 3078 Then
DoCmd.TransferDatabase acLink, "Microsoft Access", _
quelle, acTable, tabnam, tabnam
ElseIf Err.Number = 3024 Or Err.Number = 3044 Or Err.Number = 3043 Then
CurrentDb.Execute "DROP TABLE [" & tabnam & "];"
Else
MsgBox "Fehler: " & Err.Number & " - " & Err.Description
Stop
End If
Resume
End Sub
Sub db_aendern(p As String)
Dim t As DAO.TableDef
Dim rs As DAO.Recordset
For Each t In CurrentDb.TableDefs()
If t.Connect <> "" Then
CurrentDb.Execute "DROP TABLE [" & t.Name & "];"
End If
Next
Set rs = CurrentDb.OpenRecordset("sys")
rs.MoveFirst
rs.Edit
rs!dbnam = p
rs.Update
rs.Close
End Sub
Function dateioeffnen(datnam As String, titel As String) As String
With Application.FileDialog(1)
.AllowMultiSelect = False
.Title = titel
.InitialFileName = datnam
If .Show = -1 Then
dateioeffnen = .SelectedItems(1)
Else
dateioeffnen = ""
End If
End With
End Function
Ich hoffe das hilft Leuten die ein ähnliches Problem haben.
Mit freundlichen Grüßen
Churian