Forums Neueste Beiträge
 

Fehler beim einbinden von Tabellen

29/08/2007 - 16:00 von Sebastian Schelker | Report spam
Hallo NG'ler

Ich brauche leider schon wieder eure Hilfe.

Ich habe eine kleine Produktedatenbank erstellt. Bis jetzt hat sie gut
funktioniert.

Ich habe von der knowhow db die codezeilen übernommen zum einbinden
von Tabellen. Habe das ganz noch an meine Ansprüche angepasst.

Die erste Zeit über, hat das einbinden klasse geklappt. Wenn der pc
nicht am Netz war hat er auch C zugegriffen.

Nun auf einmal bekomme ich Fehlermeldungen bei einbinden und zwar wie
folgt:

Wenn ich den Pc vom Netz nehme und die DB zum ersten Mal wieder öffne,
kommt die Fehlermeldung "Tabellen konnten nicht Ordnungsgemàss
eingebunden werden.

Wenn ich die DB aber wieder schliesse und nochmals öffne, sind alle
Tabs richtig eingebunden und es kommt auch keine Fehlermeldung mehr.

Das selbe passiert, wenn ich den PC wieder ans Netz tue. Beim ersten
öffnen kommt Fehler. Beim zweiten Mal klappts.

Hat jemand von euch eine Idee an was das liegen kann?

Hier der Code:
Option Compare Database
Option Explicit
Option Base 0

Const OFN_FILEMUSTEXIST = &H1000
Const OFN_PATHMUSTEXIST = &H800
Const OFN_HIDEREADONLY = &H4
Const OFN_READONLY = &H1
Const OFN_OVERWRITEPROMPT = &H2

'Neu in 3.0:
' Zusàtzlich die separate Function EinzelTab_Einbind, mit der man eine
einzelne Tabelle sicher einbinden kann

'switchConnect: a) Vorgeschlagen wird immer das Directory, in dem sich
die Programm-Datenbank befindet
' b) Auskommentiertes Beispiel, wie man immer
automatisch mit einer "festen" Daten-Datenbank
' anstelle des Dialoges verbinden kann

' VERBINDEN
' ==
'Neu in 3.0
'Function DatenMDBWechsel() - damit kann man das neuEinbinden
"erzwingen"

' Modul aus einer àlteren ACCESS 2.0 Datenbank auf ACCESS 97 adaptiert

' Verwendet u.a. das Klassenmodul FileDialog

' Verwendung auf EIGENE GEFAHR !!

' Mittels dieser Funktionen kann eine Programm-Datenbank mit einer
Daten-Datenbank
' verbunden werden. Es ist so aufgebaut, daß man es einfach in das
AUTOEXEC Makro
' einbinden kann. Es prüft anhand einer einzigen Tabelle, ob diese
korrekt
' geöffnet werden kann.
' Wenn ja (Daten-Datenbank wurde nicht verschoben)
' dann wird davon ausgegangen, daß die Tabellen OK sind. Wenn diese
Tabelle
' nicht geöffnet werden kann (Daten-Datenbank wurde verschoben),
' wird der Datei-Öffnen-Dialog eingeblendet und
' der Benutzer kann sich eine Daten-Datenbank aussuchen. Sofern die
Tabellen
' dort gefunden werden, werden diese Tabellen eingebunden.
'
' Einfach folgende Zeile in das AUTOEXEC - Makro:
' AusführenCode
' und als Option (ohne Anführungszeichen)
' "checkconnect()"
'
'Dazu muß das Modul wie folgt angepaßt werden:
'
' Im Modul mdlVerbinden:

' Function checkconnect()
' Der Tabellenname muß geàndert werden
'Set tbl = db.OpenRecordset("tblBeispiel")

'Function DatenMDBWechsel()
' Der Tabellenname muß geàndert werden
' gleicher Tabellenname wie bei checkconnect
' DoCmd.DeleteObject acTable, "tblBeispiel"

' Function switchConnect()

' Start-Directory und Beschriftung festlegen.
' Hier das Start-Directory eingeben, in dem die Dateisuche anfangen
soll
' Der Dateiname ist nur ein Dummy und wird nicht verwendet.
' StartDir = "C:\Eigene Dateien\Dummy.mdb"

' Hier die Beschriftung für den Dialog der Dateisuche eingeben
' StBeschriftung = "Daten-Datenbank suchen"

' Function ConnectDB()

' Hier müssen die gewünschten Tabellen "hardcoded" eingegeben werden.
' Dies hat den Vorteil gegenüber einer Prozedur "alle Einbinden", daß
man
' selektiv Tabellen auswàhlen kann, die eingebunden werden sollen.
' Sofern es sich um mehr als 15 Tabellen handelt, muß auch
' die Konstante MAXTABLES angepaßt werden.

'Const MAXTABLES = 15
'Static tables(MAXTABLES) As String

' tables(0) = "tblBeispiel"
' tables(1) = "tblTest1"
' tables(2) = "tblTest2"
' tables(3) = ""
' tables(4) = ""
' tables(5) = ""
' tables(6) = ""
' tables(7) = ""
' tables(8) = ""
' tables(9) = ""
' tables(10) = ""
' tables(11) = ""
' tables(12) = ""
' tables(13) = ""
' tables(14) = ""
' tables(15) = ""
'
'=


Function checkconnect()
DoCmd.openform "pcart", , , , , acHidden
If Forms!pcart!laptopoderpcid = 2 Then
If Len(Dir("K:\Berlknowledge\BERLKNOWLEDGE V1.0_be.mdb")) > 0 Then
Exit Function
Else
MsgBox "Netzwerk nicht verfügbar. Bitte kontaktieren Sie den
Administrator."
Call close_db
End If
Else
If Len(Dir("K:\Berlknowledge\BERLKNOWLEDGE V1.0_be.mdb")) > 0 Then
If Mid(CurrentDb!Benutzer.Connect, 11) = "K:\Berlknowledge
\BERLKNOWLEDGE V1.0_be.mdb" Then
DoCmd.openform "Anmeldung"
Forms!Anmeldung![statusnetz] = "Online"
Exit Function
Else
Call switchConnect2
End If
Else
If Mid(CurrentDb!Benutzer.Connect, 11) = "C:\Berlknowledge
\BERLKNOWLEDGE V1.0_be.mdb" Then
DoCmd.openform "Anmeldung"
Forms!Anmeldung![statusnetz] = "Offline"
Exit Function
Else
Call switchConnect
MsgBox "Sie haben kein Netzwerkzugriff. Sie werden mit Iherer
lokalen Datenbank verbunden"
End If
End If
End If
End Function

Function DatenMDBWechsel()
'Man kann die Funktion verwenden, wenn man mehrere Daten-Datenbanken
hat, um
'zwischen diesen wechseln zu können, oder als Testfunktion des
Moduls ...
On Error Resume Next
DoCmd.DeleteObject acTable, "Benutzer"
On Error GoTo DatenMDBWechsel_Err
checkconnect
DatenMDBWechsel_Exit:
Exit Function
DatenMDBWechsel_Err:
MsgBox Error$
Resume DatenMDBWechsel_Exit
End Function

Function switchConnect()

'switchConnect: a) Vorgeschlagen wird immer das Directory, in dem sich
die Programm-Datenbank befindet
' b) Auskommentiertes Beispiel, wie man immer
automatisch mit einer "festen" Daten-Datenbank
' anstelle des Dialoges verbinden kann

'Stellt Dialog zur Auswahl einer neuen Datenbank dar
'Nach Auswahl einer neuen adrdata.mdb werden die benötigten Tabellen
aus dieser
'verbunden
Dim db As Database
Dim newdb As String
Dim Nix As Integer
Dim i As Integer, countfrm As Integer
Dim frm As Form
Dim fd As New FileDialog
Dim startdir As String
Dim StBeschriftung As String
Dim X As String

On Error GoTo Error_switchConnect

' Start-Directory und Beschriftung festlegen.
' Hier das Start-Directory eingeben, in dem die Dateisuche anfangen
soll
' Neu: Es wird immer das aktuelle Directory der "Haupt-MDB" angezeigt
startdir = "C:\Berlknowledge\BERLKNOWLEDGE V1.0_be.mdb"

''''''''''' Neu in Vers. 3.0:
''''''''''' Wenn im aktuellen Directory die Datei "DeineDaten.mdb"
vorhanden ist, wird mit dieser
''''''''''' verbunden, ansonsten wird nach der Datenbank gefragt ...
'''''''''''

'''''' Kommentarzeichen
weg ...''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' If Len(Trim(Nz(Dir(startdir & "DeineDaten.MDB")))) > 0 Then
' newdb = startdir & "DeineDaten.mdb"
' Else

'''''' Kommentarzeichen
weg ...''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' weiter unten beim End If muß ggf. noch das Kommentarzeichen weg




newdb = "C:\Berlknowledge\BERLKNOWLEDGE V1.0_be.mdb"

'''''' Kommentarzeichen
weg ...''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' End If

'''''' Kommentarzeichen
weg ...''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

If Len(newdb) > 0 Then
' Wenn Datenbank verbunden
'Alle Formulare aktualisieren
'Dazu alle Formulare merken und schliessen
countfrm = Forms.count
If countfrm > 0 Then
ReDim merkform(countfrm) As String
For i = 0 To countfrm - 1
Set frm = Forms(i)
merkform(i) = frm.Name
Next i
For i = 0 To countfrm - 1
Nix = frmClose(merkform(i))
Next i
End If

'Datenbank neu verbinden
Set db = DBEngine.Workspaces(0).Databases(0) 'Für eigene Datenbank
If Not ConnectDB(db, newdb) Then
Nix = MsgBox("Tabellen konnten nicht ordungsgemàß verbunden
werden ", vbCritical, "Fehler beim Verbinden")
Exit Function
End If

'Alle Formulare wieder öffnen
For i = 0 To countfrm - 1
Nix = frmOpen(merkform(i), vbNormal)
Next i
'Else
' Fehler
End If
DoCmd.openform "Anmeldung"
Forms!Anmeldung![statusnetz] = "Offline"

Exit Function

Error_switchConnect:
MsgBox Error$, , "Error_btnSuchen_Clickd Sub"
Resume switchConnect_Exit

switchConnect_Exit:
End Function

Function ConnectDB(db As Database, datapath As String) As Integer
'Verbindet alle Datendatenbank in der Datenbank db neu
'datapath: Datenbank mit der Verbindung hergestellt werden soll
'Rückgabe: TRUE, erfolgreich verbunden
' FALSE, Verbindungen konnten nicht hergestellt werden

Const TEMPTBL = "~temp"

Dim i As Integer

' Hier müssen die gewünschten Tabellen "hardcoded" eingegeben werden.
' Dies hat den Vorteil gegenüber einer Prozedur "alle Einbinden", daß
man
' selektiv Tabellen auswàhlen kann, die eingebunden werden sollen.
' Sofern es sich um mehr als 15 Tabellen handelt, muß auch
' die Konstante MAXTABLES angepaßt werden.

Const MAXTABLES = 38
Static Tables(MAXTABLES) As String

Tables(0) = "Benutzer"
Tables(1) = "ibTAT_Applikationstechnik cs"
Tables(2) = "ibTKS_Kundenspezifikationen cs"
Tables(3) = "ibTPS_Substrate cs"
Tables(4) = "ibTT_Tests"
Tables(5) = "ibTTR_Trocknungsart"
Tables(6) = "L_TL_Lexikon"
Tables(7) = "N_TNS_News"
Tables(8) = "N_uTNK_News Kategorie"
Tables(9) = "TAT_Applikationstechnik"
Tables(10) = "TKS_Kundenspezifikationen"
Tables(11) = "TLL_Lösemittel"
Tables(12) = "TP_Produkt"
Tables(13) = "TPS_Substrate"
Tables(14) = "TT_Tests"
Tables(15) = "TTR_Trocknungsart"
Tables(16) = "uibTH_Haftung"
Tables(17) = "uTB_Berichte"
Tables(18) = "uTB_BlasenMenge"
Tables(19) = "uTBG_Blasengrösse"
Tables(20) = "uTD_Dokumente"
Tables(21) = "uTET_Effekttyp"
Tables(22) = "uTFV_Farbtonverànderung"
Tables(23) = "uTHA_Hàrter"
Tables(24) = "uTJN_Wert"
Tables(25) = "uTJN2_Wert2"
Tables(26) = "uTJN3_Wert3"
Tables(27) = "uTJN4_Wert4"
Tables(28) = "uTK_Kommentar"
Tables(29) = "uTLM_Bindemittelbasis"
Tables(30) = "uTPT_Produkttyp"
Tables(31) = "Z_Zeichen"
Tables(32) = "M_Products"
Tables(33) = "M_Source"
Tables(34) = "M_Wert"
Tables(35) = "B_Products"
Tables(36) = "B_Glanzgrad"
Tables(37) = "B_Wert"
Tables(38) = "BK_Kunde"

On Error GoTo ConnectDBError

'Prüfen, ob alle Verbindungen hergestellt werden können
For i = 0 To MAXTABLES
If Len(Nz(Tables(i))) > 0 Then
If Not Verbinde(db, TEMPTBL, Tables(i), datapath) Then
On Error Resume Next
DoCmd.DeleteObject acTable, TEMPTBL
ConnectDB = False
Exit Function
End If
End If
Next i

'Temp. Tabelle löschen
DoCmd.DeleteObject acTable, TEMPTBL

'Connect
For i = 0 To MAXTABLES
If Len(Nz(Tables(i))) > 0 Then
If Not Verbinde(db, Tables(i), Tables(i), datapath) Then
ConnectDB = False
Exit Function
End If
End If
Next i

ConnectDB = True
Exit Function

ConnectDBError:
On Error Resume Next
ConnectDB = False
Exit Function
End Function


'*****************************************************************************
' Function Verbinde()
'
' Verbindet die Tabelle mytab in der Datenbank db unter den Namen
ntab mit der Datenbank strdb
'Rückgabe: TRUE, Verbindung erfolgreich hergestellt
' FALSE, Verbindung konnte nicht hergestellt werden
'*****************************************************************************
Private Function Verbinde(db As Database, ByVal ntab As String, ByVal
mytab As String, ByVal strDb As String) As Integer

Dim mytable As TableDef
'-
On Error Resume Next
'Bestehende Verbindung löschen
DoCmd.DeleteObject acTable, ntab
On Error GoTo 0

'On Error GoTo VerbindeError1
'Wenn hier Fehler auftritt ist Tabelle noch nicht eingebunden
'Set mytable = db.TableDefs(mytab)
'Jetzt wird bestehende Verbindung aktualisiert
'mytable.SourcetableName = mytab
'mytable.connect = ";DATABASE=" & strdb
'mytable.RefreshLink
'Verbinde = True
'Exit Function
'VerbindeError1:

On Error GoTo VerbindeError
'Tabelle neu einbinden
Set mytable = db.CreateTableDef(ntab)

mytable.SourceTableName = mytab

'hier könnte man auch ein einfaches Daten-Datenbank-Passwort
(hier:"Hugo") speichern ...
'mytable.Connect = "MS ACCESS;PWD=Hugo;DATABASE="

mytable.Connect = ";DATABASE=" & strDb
db.TableDefs.Append mytable
Verbinde = True
Exit Function

VerbindeError:

Verbinde = False
Exit Function

End Function

Function frmClose(ByVal frmName As String)
'Schließt das Formular frmname

DoCmd.Close acForm, frmName

End Function

Function frmOpen(ByVal frmName As String, ByVal modus)
'Öffnet das Formular frnname
'modus wie in ACCESS: acNORMAL, acHIDDEN, acICON, AcDIALOG

DoCmd.openform frmName, , , , , modus

End Function

Function TabTempLosesch()

On Error Resume Next

DoCmd.SetWarnings False
DoCmd.DeleteObject acTable, "tblBeispiel"
DoCmd.DeleteObject acTable, "tblTest1"
DoCmd.DeleteObject acTable, "tblTest2"
DoCmd.SetWarnings True

End Function


'''''''''''''''''''''''''''''''''
'Separate Funktion, um eine einzelne Tabelle von einer MDB sicher
einzubinden
'''''''''''''''''''''''''''''''''
Function CopyUsr_verb(ByVal xtbl As String, ByVal xdb As String,
Optional XPasswd As String = "", Optional ByVal NeuTabNam As String)
As Boolean
'
' xtbl = "tabname zu einbinden"
' xdb = "Data mdb pfad"
' XPasswd = Datenbankpasswort
' NeuTabNam = abweichender neuer Tabellenname
'
' Wenn kein "\" in xdb vorhanden ist, muss die xdb im gleichen
Directory wie die "current" mdb stehen
' Optional kann ein Passwort mitgegeben werden sowie ein neuer Name
für die Tabelle
'
' Beispiele:
' CopyUsr_verb("tblBearbeiter","Hugo.mdb")
' CopyUsr_verb("tblBearbeiter","C:\Hugo\Hugo.mdb")
' CopyUsr_verb("tblBearbeiter","Hugo.mdb","Hugo")
' CopyUsr_verb("tblBearbeiter","C:\Hugo\Hugo.mdb","Hugo","tblHugo")
'Als Tabelle mit Namen tblHugo
'
Dim db As Database
Dim Daten As String
Dim i As Integer

Dim mytable As TableDef
'-
CopyUsr_verb = False

On Error Resume Next
'Wenn kein anderer Name gewünscht, den gleichen Namen verwenden
If Len(Trim(Nz(NeuTabNam))) = 0 Then
NeuTabNam = xtbl
End If

'Bestehende Verbindung löschen
DoCmd.DeleteObject acTable, NeuTabNam

On Error GoTo FehlerMeldung

Set db = CurrentDb()
Set mytable = db.CreateTableDef(NeuTabNam)

mytable.SourceTableName = xtbl

If InStr(1, xdb, "\", vbBinaryCompare) > 0 Then
Daten = xdb
Else
Daten = Left(db.Name, Len(db.Name) - Len(Dir(db.Name))) & xdb
End If

If Len(Trim(Nz(XPasswd))) > 0 Then
mytable.Connect = ";PWD=" & XPasswd & ";" & ";DATABASE=" & Daten
Else
mytable.Connect = ";DATABASE=" & Daten
End If

db.TableDefs.Append mytable

Set db = Nothing
CopyUsr_verb = True

Exit Function
FehlerMeldung:
CopyUsr_verb = False
MsgBox "Bei der Einbindung von " & xtbl & " ist ein Fehler
aufgetreten. ", 16, xdb & " - Fehler"
End Function

Function switchConnect2()

'switchConnect: a) Vorgeschlagen wird immer das Directory, in dem sich
die Programm-Datenbank befindet
' b) Auskommentiertes Beispiel, wie man immer
automatisch mit einer "festen" Daten-Datenbank
' anstelle des Dialoges verbinden kann

'Stellt Dialog zur Auswahl einer neuen Datenbank dar
'Nach Auswahl einer neuen adrdata.mdb werden die benötigten Tabellen
aus dieser
'verbunden
Dim db As Database
Dim newdb As String
Dim Nix As Integer
Dim i As Integer, countfrm As Integer
Dim frm As Form
Dim fd As New FileDialog
Dim startdir As String
Dim StBeschriftung As String
Dim X As String

On Error GoTo Error_switchConnect

' Start-Directory und Beschriftung festlegen.
' Hier das Start-Directory eingeben, in dem die Dateisuche anfangen
soll
' Neu: Es wird immer das aktuelle Directory der "Haupt-MDB" angezeigt
startdir = "K:\Berlknowledge\BERLKNOWLEDGE V1.0_be.mdb"

''''''''''' Neu in Vers. 3.0:
''''''''''' Wenn im aktuellen Directory die Datei "DeineDaten.mdb"
vorhanden ist, wird mit dieser
''''''''''' verbunden, ansonsten wird nach der Datenbank gefragt ...
'''''''''''

'''''' Kommentarzeichen
weg ...''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' If Len(Trim(Nz(Dir(startdir & "DeineDaten.MDB")))) > 0 Then
' newdb = startdir & "DeineDaten.mdb"
' Else

'''''' Kommentarzeichen
weg ...''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' weiter unten beim End If muß ggf. noch das Kommentarzeichen weg

newdb = "K:\Berlknowledge\BERLKNOWLEDGE V1.0_be.mdb"

'''''' Kommentarzeichen
weg ...''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' End If

'''''' Kommentarzeichen
weg ...''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

If Len(newdb) > 0 Then
' Wenn Datenbank verbunden
'Alle Formulare aktualisieren
'Dazu alle Formulare merken und schliessen
countfrm = Forms.count
If countfrm > 0 Then
ReDim merkform(countfrm) As String
For i = 0 To countfrm - 1
Set frm = Forms(i)
merkform(i) = frm.Name
Next i
For i = 0 To countfrm - 1
Nix = frmClose(merkform(i))
Next i
End If

'Datenbank neu verbinden
Set db = DBEngine.Workspaces(0).Databases(0) 'Für eigene Datenbank
If Not ConnectDB(db, newdb) Then
Nix = MsgBox("Tabellen konnten nicht ordungsgemàß verbunden
werden ", vbCritical, "Fehler beim Verbinden")
Exit Function
End If

'Alle Formulare wieder öffnen
For i = 0 To countfrm - 1
Nix = frmOpen(merkform(i), vbNormal)
Next i
'Else
' Fehler
End If
DoCmd.openform "Anmeldung"
Forms!Anmeldung![statusnetz] = "Online"
Exit Function
Error_switchConnect:
MsgBox Error$, , "Error_btnSuchen_Clickd Sub"
Resume switchConnect_Exit
switchConnect_Exit:
End Function
 

Lesen sie die antworten

#1 Thomas Möller
29/08/2007 - 16:41 | Warnen spam
Hallo Sebastian,

Sebastian Schelker schrieb:
Ich habe von der knowhow db die codezeilen übernommen zum einbinden
von Tabellen. Habe das ganz noch an meine Ansprüche angepasst.

Die erste Zeit über, hat das einbinden klasse geklappt. Wenn der pc
nicht am Netz war hat er auch C zugegriffen.

Nun auf einmal bekomme ich Fehlermeldungen bei einbinden und zwar wie
folgt:

Wenn ich den Pc vom Netz nehme und die DB zum ersten Mal wieder öffne,
kommt die Fehlermeldung "Tabellen konnten nicht Ordnungsgemàss
eingebunden werden.

Wenn ich die DB aber wieder schliesse und nochmals öffne, sind alle
Tabs richtig eingebunden und es kommt auch keine Fehlermeldung mehr.

Das selbe passiert, wenn ich den PC wieder ans Netz tue. Beim ersten
öffnen kommt Fehler. Beim zweiten Mal klappts.

Hat jemand von euch eine Idee an was das liegen kann?




die Meldung, die da erscheint kommt aus einer MsgBox in Deinem Code.

Du könntest in dieser Zeile einen Haltepunkt setzen


If Not ConnectDB(db, newdb) Then


Dann kannst Du den Code Schritt für Schritt durchgehen. Dabei wird Dir
dann wahrscheinlich auffallen, an welcher Stelle eine Bedingung nicht
erfüllt ist, die eigentlich erfüllt sein sollte. So kannst Du den Fehler
eingrenzen / finden.

HTH
Thomas

Homepage: www.Team-Moeller.de

Ähnliche fragen