title image


Smiley Hier der Code:
Beim Starten der Datenbank checke ich zuerst, ob es sich um eine MDE-Datei handelt mit der Funktion IstMDE, dann prüfe ich, ob die MDE-Datei vom Serverlaufwerk aus aufgerufen wurde. (Das will ich unterbinden, damit die persönlichen Eisntellungen, die für jeden Benutzer gemacht werden, nicht gleichzeitig wieder überschrieben werden).

Und dann schaue ich, ob ein update verfügbar ist.

Natürlich nehme ich mich davon aus, deswegen der Check über Environ.

Bei weiteren Fragen... frage... :-)



Function starten()

Dim TabOrt As DAO.Recordset

Dim Laufwerk As String

Varrueckgabe = SysCmd(acSysCmdSetStatus, "Arbeitsbereich wird wiederhergestellt, bitte warten...")

DoCmd.Hourglass True



If Not Environ("NWUsername") = "mschaefe" Then

If IstMDEDatei(CurrentDb) = True Then

    Set TabOrt = CurrentDb.OpenRecordset("Select * from PfadundDateiname")

        If Not TabOrt.RecordCount = 0 Then

        Laufwerk = Left$(TabOrt(0), 3)

        

            If Left$(CurrentDb.Name, 3) = Laufwerk And Not (Left$(CurrentDb.Name, 3) = "M:\" Or _

            Left$(CurrentDb.Name, 3) = "C:\" Or Left$(CurrentDb.Name, 3) = "D:\") Then

                MsgBox ("Bitte kopieren Sie die Anwendung auf Ihr persönliches Laufwerk!")

                Application.Quit acQuitSaveAll

            End If

        End If

End If

        updatepruefen

    End If

Call EinstellenStarteigenschaften

DoCmd.Hourglass False

DoCmd.Echo True

Varrueckgabe = SysCmd(acSysCmdClearStatus)

End Function



Function updatepruefen()

Dim RST As DAO.Recordset

Dim Pfad, Dname, Docname, datname As String, DateiDatum, MDEDatum As Date

Dim A, b

Set RST = CurrentDb.OpenRecordset("Select * from Pfadunddateiname")

Pfad = MID(RST(0), 1, InStr(1, RST(0), "TabellenPAB.mdb") - 1)

Dname = "Frontend Projektdatenbank.mde"

Set A = CreateObject("Scripting.FileSystemObject")

Set b = A.GetFile(Pfad & Dname)

MDEDatum = b.datelastmodified

Set b = A.GetFile(CurrentDb.Name)

DateiDatum = b.datelastmodified

If DateiDatum < MDEDatum Then

updatepruefen = True

Else

updatepruefen = False

End If

If updatepruefen = True Then

DoCmd.Hourglass False

DoCmd.Echo True

 MsgBox ("Auf " & Pfad & " ist eine neuere Version verfügbar, bitte aktualisieren Sie ihre Frontend-Anwendung!")

Application.Quit acQuitSaveAll

End If

End Function



Function IstMDEDatei(DBS As DATABASE) As Boolean

    Dim strMDE As String

    On Error Resume Next

    strMDE = DBS.Properties("MDE")

    If Err = 0 And strMDE = "T" Then

        ' Dies ist eine MDE-Datenbank.

        IstMDEDatei = True

    Else

        IstMDEDatei = False

    End If

End Function



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: