Liebe Access-Profis,
meine DB ist in eine Frontend-/Backend-Struktur aufgelöst und mittlerweile habe ich diese FE mehreren Anwendern zur Verfügung gestellt. Bei Änderungen muss ich nun manuell an allen Rechnern die jeweils neueste Version aufspielen.
Jetzt war mein Ansinnen (Idee habe ich in der Literatur gefunden), diese FE automatisiert upzudaten.
Dafür habe ich einen Code gefunden, der noch auf der Grundlage der 2003-Version (*.mdb) entwickelt wurde.
Das Prinzip funktioniert folgendermaßen:
- Masterdatei (ohne Update-Code); wird zentral auf den Server gespeichert
- AnwenderFE-Datei (mit Update-Code) vergleicht per AutoExec-Makro beim Start das jeweilige Datum der Veränderung eines jeden Access-Objektes (Detail-Ansicht bei Abfragen, Formulare, Berichte, Module) und importiert entsprechend das neuere Objekt; das bisher existierende Objekt wird mit dem Zusatz "/Alt" kopiert und dient im Fehlerfall zum Rollback.
Function AutoUpdateFrontEnd()
Dim dbIntern As DAO.Database, dbExtern As DAO.Database
Dim conIntern As DAO.Container, conExtern As DAO.Container
Dim Q As QueryDef, docTemp As Document
Dim strName As String, dtLast As Date
Dim arrObjects As Variant
Dim arrConst As Variant
Dim I&
Const MasterFrontEnd = "...Pfad...\SB_Al_M.accdb"
arrObjects = Array("Forms", "Reports", "Scripts", "Modules")
arrConst = Array(acForm, acReport, acMacro, acModule)
On Error Resume Next
Set dbExtern = OpenDatabase(MasterFrontEnd)
If Err <> 0 Then
Beep
MsgBox "Master-FrontEnd nicht gefunden oder momentan nicht verfügbar...", _
vbOKOnly + vbCritical, "!!! Problem !!!"
Set dbExtern = Nothing
Exit Function
End If
'Abfragen prüfen...
Set dbIntern = CurrentDb()
For Each Q In dbIntern.QueryDefs
strName = Q.Name
If Left$(strName, 1) = "~" Then GoTo SkipTempQuery
dtLast = Q.LastUpdated
If CheckQueryDate(dbExtern, strName, dtLast) Then
MsgBox "Geänderte Abfrage: " & strName
DoCmd.DeleteObject acQuery, strName & "/Alt"
DoEvents
DoCmd.Rename strName & "/Alt", acQuery, strName
DoEvents
DoCmd.TransferDatabase acImport, _
"Microsoft Access", _
MasterFrontEnd, _
acQuery, _
strName, _
strName
End If
SkipTempQuery:
DoEvents
Next Q
'Formulare, Berichte, Makros und Module prüfen...
For I = LBound(arrObjects) To UBound(arrObjects)
Set conIntern = dbIntern.Containers(arrObjects(I))
Set conExtern = dbExtern.Containers(arrObjects(I))
For Each docTemp In conIntern.Documents
strName = docTemp.Name
dtLast = docTemp.LastUpdated
If CheckDocDate(conExtern, strName, dtLast) Then
MsgBox "Geändert/" & arrObjects(I) & ": " & strName
If arrConst(I) = acMacro And strName = "AutoExec" Then
GoTo SkipDoc
End If
If arrConst(I) = acModule Then
DoCmd.DeleteObject arrConst(I), strName
DoEvents
Else
DoCmd.DeleteObject arrConst(I), strName & "/Alt"
DoEvents
DoCmd.Rename strName & "/Alt", arrConst(I), strName
End If
DoEvents
DoCmd.TransferDatabase acImport, _
"Microsoft Access", _
MasterFrontEnd, _
arrConst(I), _
strName, _
strName
End If
SkipDoc:
DoEvents
Next docTemp
Next I
dbExtern.Close
Beep
MsgBox "Ihre SBBZ-Datenbank ist aktualisiert...", vbOKOnly + vbInformation, "SBBZ_Datenbank aktualisieren:"
Exit Function
End Function
Function CheckQueryDate(db As DAO.Database, strName As String, dtDate As Date) As Boolean
Dim bolTemp As Boolean
On Error Resume Next
bolTemp = (db.QueryDefs(strName).LastUpdated > dtDate)
If Err <> 0 Then 'Nicht in Master vorhanden...
CheckQueryDate = False
Else
CheckQueryDate = bolTemp
End If
End Function
Function CheckDocDate(con As DAO.Container, strName As String, dtDate As Date) As Boolean
Dim bolTemp As Boolean
On Error Resume Next
bolTemp = (con.Documents(strName).LastUpdated > dtDate)
If Err <> 0 Then 'Nicht in Master vorhanden...
CheckDocDate = False
Else
CheckDocDate = bolTemp
End If
End Function
Das AutoExec-Makro ruft neben dem obigen Code noch folgende Prozedur auf:
Function ETPrüfen() As Integer
Dim db As DAO.Database, rs As DAO.Recordset
Dim intAnzCon As Integer, intAnzTabs As Integer
Dim I As Integer, J As Integer
Dim strConn As String, strDBPath As String, strTabName As String
Dim strNewPath As String, strPath As String, strFile As String
DoCmd.Hourglass True
Set db = CurrentDb
intAnzCon = db.Containers.Count
For I = 0 To intAnzCon - 1
DoEvents
If db.Containers(I).Name = "Tables" Then
intAnzTabs = db.Containers(I).Documents.Count
For J = 0 To intAnzTabs - 1
DoEvents
On Error Resume Next
strConn = db.TableDefs(J).Connect
If strConn <> "" Then
strTabName = db.TableDefs(J).Name
strDBPath = Mid$(LCase$(strConn), InStr(strConn, "database=") + 9)
If InStr(strDBPath, ";") <> 0 Then
strDBPath = Left$(strDBPath, InStr(strDBPath, ";") - 1)
End If
If Dir$(strDBPath) = "" Then
strPath = PathOnly(strDBPath)
strFile = FilenameOnly(strDBPath)
strNewPath = LinkDBsuchen(strTabName, strPath, strFile)
If strNewPath = "" Then Exit For
DoEvents
db.TableDefs(J).Connect = ";DATABASE=" + UCase$(strNewPath)
db.TableDefs(J).RefreshLink
End If
End If
Next J
DoEvents
Exit For
End If
Next I
DoEvents
DoCmd.Hourglass False
End Function
Function FilenameOnly$(aFile$)
Dim L%, X$
FilenameOnly = ""
X$ = aFile$
If InStr(X$, "\") <> 0 Then
L = Len(X$)
While Mid$(X$, L, 1) <> "\" And L > 0
L = L - 1
Wend
If L = 1 Then Exit Function
X$ = Mid$(X$, L + 1)
End If
FilenameOnly = X$
End Function
Function LinkDBsuchen(TName$, aPath$, aFile$)
Dim Filter$, Title$, FileName$
LinkDBsuchen = "" 'Nichts ausgewählt
Filter$ = "Datenbanken (*.*db)|*.*db|Alle Dateien (*.*)|*.*|"
Title$ = "Datenbank für eingebundene Tabelle '" & TName$ & "' suchen:"
LinkDBsuchen = OpenFile(Title$, aPath$, aFile$, Filter$)
End Function
Function PathOnly$(aPath$)
Dim L%
PathOnly = ""
If InStr(aPath$, "\") = 0 Then Exit Function
L = Len(aPath$)
While Mid$(aPath$, L, 1) <> "\" And L > 0
L = L - 1
Wend
If L > 1 Then PathOnly = Left$(aPath$, L)
End Function
Nun mein Problem:
- Die Frontend-Datei erkennt und vergleicht die Verschiedenheit der Änderungsdaten und meldet diese sinngemäß, dass das Objekt xy aktualisiert wurde. Letztlich sieht der Anwender auch die Meldung, dass seine FE zur Gänze aktualisiert wurde. Aber: Es passiert bzgl. der Objekt-Operationen nichts.
Wenn ich die Masterdatei mit der Endung ".mdb" abspeichere, dann werden wenigstens die Abfragen korrekt verarbeitet, alle anderen Objekte aber nicht?!
Es wurden ergänzend noch folgende Funktionen im Code zum Modul 'ETPruefen' abgelegt:
Type xOPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As Long
nMaxCustrFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustrData As Long
lpfnHook As Long
lpTemplateName As Long
End Type
Type MSA_OPENFILENAME
' Für die Filter des Dialogfelds 'Öffnen' verwendete Filterzeichenfolge.
' Dazu MSA_CreateFilterString() verwenden.
' Standard = Alle Dateien, *.*
strFilter As String
' Anfangs angezeigter Filter.
' Standard = 1.
lngFilterIndex As Long
' Anfangsverzeichnis für das Dialogfeld 'Öffnen'.
' Standard = Aktuelles Arbeitsverzeichnis.
strInitialDir As String
' Dateiname, mit dem das Dialogfeld anfangs gefüllt wird.
' Standard = "".
strInitialFile As String
strDialogTitle As String
' Standarderweiterung, die an den Dateinamen angehängt wird, wenn der Benutzer
' keine angab.
' Default = Systemwerte (Datei öffnen, Datei speichern).
strDefaultExtension As String
' Zu verwendende Kennzeichen (siehe Liste der Konstanten).
' Standard = keine Kennzeichen.
lngFlags As Long
' Vollständiger Pfad der gewählten Datei. Wenn das Dialogfeld 'Datei öffnen'
' angezeigt wird und der Benutzer eine nicht vorhandene Datei wählt, wird
' nur der Text im Feld 'Dateiname' zurückgegeben.
strFullPathReturned As String
' File name of file picked.
strFileNameReturned As String
' Offset in full path (strFullPathReturned) where the file name
' (strFileNameReturned) begins.
intFileOffset As Integer
' Offset im vollständigen Pfad (strFullPathReturned), an dem die Dateierweiterung
' beginnt.
intFileExtension As Integer
End Type
Const ALLFILES = "Alle Dateien"
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As xOPENFILENAME) As Boolean
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As xOPENFILENAME) As Boolean
Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_ENABLEHOOK = &H20
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_EXPLORER = &H80000
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_LONGNAMES = &H200000
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_NOLONGNAMES = &H40000
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOTESTFILECREATE = &H10000
Public Const OFN_NOVALIDATE = &H100
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_READONLY = &H1
Public Const OFN_SHAREAWARE = &H4000
Public Const OFN_SHAREFALLTHROUGH = 2
Public Const OFN_SHARENOWARN = 1
Public Const OFN_SHAREWARN = 0
Public Const OFN_SHOWHELP = &H10
Function MSA_ConvertFilterString(strFilterIn As String) As String
' Erstellt eine Filterzeichenfolge aus einer mit Balken ("|") unterteilten Zeichenfolge.
' Die Zeichenfolge sollte Paare aus Filter|Erweiterung enthalten, d.h.
' "Access-Datenbanken|*.mdb|Alle Dateien|*.*"
' Wenn für das letze Filterpaar keine Erweiterungen vorhanden sind, wird *.* hinzugefügt.
' Dieser Code ignoriert leere Zeichenfolge, d.h. "||"-Paare.
' Gibt "" zurück, wenn die übergebene Zeichenfolgen leer ist.
Dim strFilter As String
Dim intNum As Integer, intPos As Integer, intLastPos As Integer
strFilter = ""
intNum = 0
intPos = 1
intLastPos = 1
' Zeichenfolgen hinzufügen, solange Balken gefunden werden.
' Leere Zeichenfolge ignorieren (nicht zulässig).
Do
intPos = InStr(intLastPos, strFilterIn, "|")
If (intPos > intLastPos) Then
strFilter = strFilter & Mid(strFilterIn, intLastPos, intPos - intLastPos) & vbNullChar
intNum = intNum + 1
intLastPos = intPos + 1
ElseIf (intPos = intLastPos) Then
intLastPos = intPos + 1
End If
Loop Until (intPos = 0)
' Letzte Zeichenfolge ermitteln, wenn vorhanden (unter der Voraussetzung, daß strFilterIn
' nicht mit einem Balken abgeschlossen war)
intPos = Len(strFilterIn)
If (intPos >= intLastPos) Then
strFilter = strFilter & Mid(strFilterIn, intLastPos, intPos - intLastPos + 1) & vbNullChar
intNum = intNum + 1
End If
' *.* hinzufügen, wenn keine Erweiterung in letzter Zeichenfolge.
If intNum Mod 2 = 1 Then
strFilter = strFilter & "*.*" & vbNullChar
End If
' Abschließendes NULL hinzufügen, wenn keinerlei Filter vorhanden ist.
If strFilter <> "" Then
strFilter = strFilter & vbNullChar
End If
MSA_ConvertFilterString = strFilter
End Function
Function MSA_CreateFilterString(ParamArray varFilt() As Variant) As String
' Erstellt aus den übergebenen Argumenten eine Filterzeichenfolge.
' Gibt "" zurück, falls keine Argumente übergeben wurden.
' Erwartet eine gerade Anzahl an Argumenten (Filtername, Erweiterung); wenn jedoch
' eine ungerade Anzahl übergeben wird, fügt sie an "*.*" hinzu.
Dim strFilter As String
Dim intRet As Integer
Dim intNum As Integer
intNum = UBound(varFilt)
If (intNum <> -1) Then
For intRet = 1 To intNum
strFilter = strFilter & varFilt(intRet) & vbNullChar
Next
If intNum Mod 2 = 0 Then
strFilter = strFilter & "*.*" & vbNullChar
End If
strFilter = strFilter & vbNullChar
Else
strFilter = ""
End If
MSA_CreateFilterString = strFilter
End Function
Function MSA_OpenFile(msaof As MSA_OPENFILENAME) As String
Dim of As xOPENFILENAME
Dim I%
MSAOF_to_OF msaof, of
I = GetOpenFileName(of)
DoEvents
If I Then
OF_to_MSAOF of, msaof
Else
MsgBox "MSA_OpenFile - Fehler: " + CStr(I)
End If
MSA_OpenFile = msaof.strFullPathReturned
DoEvents
End Function
Private Sub MSAOF_to_OF(msaof As MSA_OPENFILENAME, of As xOPENFILENAME)
' Diese Prozedur konvertiert aus der Microsoft Access-Struktur in die Win32-Struktur.
Dim strFile As String * 512
' Bestimmte Teile der Struktur initialisieren.
of.hwndOwner = Application.hWndAccessApp
of.hInstance = 0
of.lpstrCustomFilter = 0
of.nMaxCustrFilter = 0
of.lpfnHook = 0
of.lpTemplateName = 0
of.lCustrData = 0
If msaof.strFilter = "" Then
of.lpstrFilter = MSA_CreateFilterString(ALLFILES)
Else
of.lpstrFilter = msaof.strFilter
End If
of.nFilterIndex = msaof.lngFilterIndex
of.lpstrFile = msaof.strInitialFile _
& String(512 - Len(msaof.strInitialFile), 0)
of.nMaxFile = 511
of.lpstrFileTitle = String(512, 0)
of.nMaxFileTitle = 511
of.lpstrTitle = msaof.strDialogTitle
of.lpstrInitialDir = msaof.strInitialDir
of.lpstrDefExt = msaof.strDefaultExtension
of.Flags = msaof.lngFlags
of.lStructSize = Len(of)
End Sub
Private Sub OF_to_MSAOF(of As xOPENFILENAME, msaof As MSA_OPENFILENAME)
' Diese Prozedur konvertiert aus der Win32-Struktur in die Microsoft Access-Struktur.
msaof.strFullPathReturned = Left(of.lpstrFile, InStr(of.lpstrFile, vbNullChar) - 1)
msaof.strFileNameReturned = of.lpstrFileTitle
msaof.intFileOffset = of.nFileOffset
msaof.intFileExtension = of.nFileExtension
End Sub
Function OpenFile(Title$, aPath$, aFile$, Filter$) As String
Dim msaof As MSA_OPENFILENAME
If Right$(Title$, 1) <> ":" Then Title$ = Title$ + ":"
If Filter$ = "" Then
Filter$ = "Alle Dateien (*.*)|*.*"
Else
Filter$ = Filter$ + "|Alle Dateien (*.*)|*.*"
End If
With msaof
.strDialogTitle = Title$
.strInitialDir = aPath$
.strInitialFile = aFile$
.strFilter = MSA_ConvertFilterString(Filter$)
.strDefaultExtension = "*.exe"
.lngFilterIndex = 1
.lngFlags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY Or OFN_LONGNAMES + OFN_EXPLORER
End With
OpenFile = MSA_OpenFile(msaof)
End Function
Doch all die Mehrheit dieser Programmierung ist für mich nicht überschaubar.
Wenn mir hierbei jemand helfen kann, dann danke ich vorab!
Viele Grüße
gromax
Hi,
vielleicht hilft:
http://www.access-o-mania.de/forum/index.php?topic=17400.msg100060#msg100060
Harald
Hallo bahasu,
vielen Dank für Deine Antwort; so richtig weiter komme ich damit allerdings nicht, weil ich ja Objekte innerhalb einer FE-Datei ansprechen möchte und nicht die BE-Datei im Gesamten.
Trotzdem danke!
Viele Grüße
gromax
Hallo,
ich finde das Vergleichen-Gehampel ziemlich überflüssig.
M. E. ist das schlichte Kopieren der "Master"-FE-Datei, die auf einem Server-Verzeichnis liegt, in ein lokales User-Verzeichnis der einfachste Weg, um eine aktuelle Version zu verteilen, bzw. zu erhalten.
Realisieren kann man das mit einem Link, der per CMD- oder Batch-Datei die FE-Datei kopiert und anschließend Access mit der DB startet.
Die Verzögerung durch das Kopieren vor den Starten ist m. E. zu verkraften. Wenn man will, könnte mittels VB-Script(!) die Version des FE (als Benutzerdefinierte Eigenschaft, die natürlich "gepflegt" werden muss) abgefragt und nur im Bedarfsfall kopiert werden.
Hi,
ich würde auch nicht die einzelnen Objekte vergleichen, sondern das Frontend komplett austauschen.
Entweder grundsätzlich, beim Start der Anwendung, oder aufgrund eines - wie auch immer stattfindenden - Versionsvergleichs.
BTW:
Zitat von: gromax am Dezember 13, 2015, 19:06:21weil ich ja Objekte innerhalb einer FE-Datei ansprechen möchte und nicht die BE-Datei im Gesamten.
Das Backend hat mit dem Austausch des Frontends nichts zu tun.
Hallo Franz, hallo MaggieMay,
vielen Dank für Eure Anregung; diese nehme ich gerne auf und werde mich daran machen. Es kann gut sein, dass ich dazu nochmals Rat brauche!
Eine gute Woche
gromax
Hallo gromax,,
Schaust Du hier www.dbdev.org (http://www.dbdev.org)
und suchst nach "MDB Loader"
gruss ekkehard
Hallo MaggieMay, hallo Franz, hallo Ekkehard,
dem Ratschlag von MaggieMay und Franz folgend habe ich nun eine Update-Funktionalität gebastelt, die in der bisherigen Testphase sehr gut funktioniert und die ich hier gerne vorstellen möchte; sie besteht aus drei Dateien:
- start.bat
Auf dem Desktop der Anwender als Verknüpfung eingerichtet; hier werden die beiden folgenden vbs-Dateien aufgerufen.
FrontEnd_Kopie.vbs
FrontEnd_Umbenennen.vbs
- FrontEnd_Kopie.vbs
Hiermit wird bei jedem DB-Start die Frontend-Datei (.accdb) immer auf jeden Anwender-PC kopiert - unabhängig, ob es sich um eine neuere Version handelt oder nicht.
'inti = Anzahl der Pfad-Zeichen ohne Dateinamen
strFrontEnd_Kopie = WScript.ScriptFullName
inti = InstrRev(strFrontEnd_Kopie,"\")
strZielPfad = Left(strFrontEnd_Kopie,inti)
strQuellPfad = "[i]Pfad zum Server - ohne Dateinennung[/i]"
strQuellDatei = strQuellPfad & "\[i]Neue Datei.accdb[/i]"
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(strQuellDatei) Then
fso.CopyFile strQuellDatei, strZielPfad, True
End if
- FrontEnd_Umbenennen.vbs
Um die neue FrontEnd-Datei vom Anwendern als Runtime-Version starten zu können, wird die vorhandene .accdr-Datei mit dem Zusatz "Backup" umbenannt; damit dies nicht mit einer bereits existierenden Backup-Datei kollidiert, wird eine solche vorab gelöscht.
Anschließend erfolgt die Umbenennung von ".accdb" in "accdr" und das FrontEnd wird gestartet.
'inti = Anzahl der Pfad-Zeichen ohne Dateinamen
strFrontEnd_Umbenennen= WScript.ScriptFullName
inti = InstrRev(strFrontEnd_Umbenennen,"\")
strZielPfad = Left(strFrontEnd_Umbenennen,inti)
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(strZielPfad & "[i]Dateinamen_Backup.accdr[/i]") Then
Set f = fso.GetFile("[i]Dateinamen.accdr[/i]")
f.Delete
End if
If fso.FileExists(strZielPfad & "[i]Bisherige Datei.accdr[/i]") Then
Set f = fso.GetFile("SB_Al.accdr")
f.name = "[i]Bisherige Datei_Backup.accdr[/i]"
End if
If fso.FileExists(strZielPfad & "[i]Neue Datei.accdb[/i]") Then
Set f = fso.GetFile("[i]Neue Datei.accdb[/i]")
f.name = "[i]Neue Datei.accdr[/i]"
End If
Set oShell = CreateObject("Shell.Application")
oShell.ShellExecute strZielPfad & "SB_Al.accdr"
Alle Dateien, also diese drei und die FE- und FE_Backup-Datei, liegen in einem Verzeichnis des Anwender-PCs.
Sollten sich darin irgendwelche Fehler, Fallen oder anderer Ungemach zeigen, wäre ich für eine Rückmeldung dankbar.
Das Tool, das mir Ekkehard vorgeschlagen hat, habe ich mir angeschaut - letztlich scheint mir dieser hier dargestellte Ablauf doch einsichtiger und auch nachvollziehbarer zu sein. Danke trotzdem!
Euch allen ein gutes neues Jahr 2016
- hoffentlich wird für alle der kommende März noch ein gutes Ende nehmen!!
Viele Grüße
gromax