title image


Smiley nicht umsonst, aber kostenlos (Spende erbeten)
Hi,



nimm das hier als "BeimÖffnen" des Hauptformulars.



If Not TableExist("Zentrale Parameter") Then

'Tabelle aus Backend noch nicht eingebunden: einbinden

Me.txtBackend_Pfad.Visible = True

Me.btnNeuerMandant.Enabled = False

Me.btnOK.Enabled = False

MsgBox "Bitte geben Sie zunächst an, wo das Backend liegt!", vbInformation, "Erster Start..."

Else

'Tabelle aus backend ist eingebunden; prüfen, ob der bisherige Pfad des Backends vom jetzigen abweicht

On Error Resume Next

strTestzugriff = DLookup("Rg_ID", "Rechnungen") 'Löst einen Fehler aus, wenn BE unerreichbar

If Err = 0 Then

'BE ist noch mit dem bisherigen Namen vorhanden; betriebsfähgkeit ist hergestellt

On Error GoTo 0

Else

'BE wurde verschoben oder umbenannt

Me.txtBackend_Pfad.Visible = True

Me.btnNeuerMandant.Enabled = False

Me.btnOK.Enabled = False

MsgBox "Bitte geben Sie zunächst an, wo das Backend liegt!", vbInformation, "Backend wurde verschoben oder umbenannt"

On Error GoTo 0

End If

End If







Dadurch wird, wenn das BE fehlt, ein Textfeld eingeblendet, wo der Pfadd zum Backend eingeblendet werden kann. Dieses Textfeld (txtBackendPfad) reagiert dann "NachAkualisierung" mit

Private Sub txtBackend_Pfad_AfterUpdate()

Dim i As Integer

If Dir(Me.txtBackend_Pfad) = "" Then

MsgBox "Die Datei wurde nicht gefunden!", vbInformation, "Datei nicht gefunden"

Else

Me.btnNeuerMandant.Enabled = True

Me.btnOK.Enabled = True

Me.btnOK.SetFocus

Me.txtBackend_Pfad.Visible = False

For i = CurrentDb.TableDefs.Count - 1 To 0 Step -1

If CurrentDb.TableDefs(i).Connect "" Then 'eingebundene Tabelle entfernen

CurrentDb.TableDefs.Delete (CurrentDb.TableDefs(i).Name)

End If

Next i

CurrentDb.TableDefs.Refresh

'Tabellen neu einbinden; dabei PW mitgeben. Die Existenz der Datei und die Nichtexistenz der Tabellen

'in der Frontend-DB stehen zu diesem Zeitpunkt fest



LinkTable Me.txtBackend_Pfad, "Zentrale Parameter", "PW"

LinkTable Me.txtBackend_Pfad, "Mandanten", "PW"

LinkTable Me.txtBackend_Pfad, "Rechnungen", "PW"



CurrentDb.TableDefs.Refresh



MsgBox "Die Datenbank wurde mit dem neuen Backend " & Me.txtBackend_Pfad & " verbunden!", vbInformation, "Verbindung erfolgreich"

Me.cboMandant_ID.Requery

End If

End Sub







Und die Routinen TableExist und LinksTable sind dann in einem Modul hinterlegt als



Function TableExist(strTableName As String) As Boolean

Dim tbl As TableDef

TableExist = False

For Each tbl In CurrentDb.TableDefs

If tbl.Name = strTableName Then

TableExist = True

Exit For

End If

Next tbl

End Function







Function LinkTable(strFilename As String, strTableName As String, strPassword As String)

Dim tbl As TableDef

Set tbl = CurrentDb.CreateTableDef(strTableName)

tbl.Connect = "MS Access;DATABASE=" & strFilename & ";PWD=" & strPassword

tbl.SourceTableName = strTableName

On Error Resume Next

CurrentDb.TableDefs.Append tbl

Set tbl = Nothing

End Function









Nehme gerne Spenden an (Konto per Mail) :-)

HTH

Martin

Martin
Atrus2711 ät gmx punkt net
Meine Beiträge zu MS Office betreffen stets Version 2000,
wenn nicht anders angegeben.




geschrieben von


Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: