Microsoft Office Access 2007-Programmierung - Das Handbuch

HINWEIS

Programmierung (Backup)

Zunächst wenden wir und dem Initialisieren der Listenfelder zu. Dafür benötigen wir einige API-Funk-

tionen

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _

(ByVal nDrive As String) As Long

Const DRIVE_REMOVABLE = 2

Const DRIVE_FIXED = 3

Const DRIVE_REMOTE = 4

Const DRIVE_CDROM = 5

Const DRIVE_RAMDISK = 6

Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" _

(ByVal lpszPath As String, ByVal lpPrefixString As String, _

ByVal wUnique As Long, ByVal lpTempFileName As String) As Long

Dim seite As Integer

Initialisieren

Listenfeld mit allen Tabellennamen füllen:

Sub liste2füllen()

Dim td As DAO.TableDef

Liste2.RowSource = ""

For Each td In CurrentDb().TableDefs

If (td.Attributes And &H80000002) = 0 Then Liste2.AddItem td.name

Next

End Sub

Systemtabellen werden herausgefiltert!

Listenfeld mit den Namen der verfügbaren Laufwerke füllen:

Sub liste1füllen()

Dim i As Integer

Liste1.RowSource = ""

For i = 0 To 25

Select Case GetDriveType(Chr(i + 65) + ":\")

Case DRIVE_REMOVABLE

If i < 3 Then

Liste1.AddItem Chr(i + 65) & ": (Diskette)"

Else

Liste1.AddItem Chr(i + 65) & ": (Wechseldatenträger)"

End If

Case DRIVE_FIXED

Liste1.AddItem Chr(i + 65) & ": (Festplatte)"

Case DRIVE_REMOTE

Liste1.AddItem Chr(i + 65) & ": (Netzlaufwerk)"

End Select

Next i

End Sub

595

Komplexbeispiel: Datenbank-Backup/-Restore

Kapitel 9: Fortgeschrittene Datenbankprogrammierung

Die Auswahl der Tabellen (Schaltflächen »Alle«/«Keine«)

:

Private Sub Befehl24_Click()

Dim i As Integer

For i = 0 To Liste2.ListCount - 1

If Not Liste2.Selected(i) Then Liste2.Selected(i) = True

Next i

End Sub

Private Sub Befehl25_Click()

Dim i As Integer

For i = 0 To Liste2.ListCount - 1

If Liste2.Selected(i) Then Liste2.Selected(i) = False

Next i

End Sub

Abschluss des Assistenten

Interessant dürfte vor allem die Funktionalität sein, die sich hinter der Schaltfläche

Fertig

verbirgt:

Private Sub Befehl28_Click()

Dim tabellen() As String, i As Integer, n As Variant, laufwerk As String, zw As String, _

f As Integer, db As Database, ws As Workspace, temp As String

Dim zielpfad As String

'On Error Resume Next

Zunächst ein paar Fehlerprüfungen:

If Liste2.ItemsSelected.Count = 0 Then

MsgBox "Wählen Sie mindestens eine Tabelle aus!", 16, "Problem"

seite = 1

DoCmd.GoToPage seite

Befehl5.Visible = True

Liste2.SetFocus

Befehl28.Visible = False

Exit Sub

End If

i = 1

ReDim tabellen(Liste2.ItemsSelected.Count)

For Each n In Liste2.ItemsSelected

tabellen(i) = Liste2.ItemData(n)

i = i + 1

Next n

Wurde ein Laufwerk ausgewählt:

If Liste1.ItemsSelected.Count = 0 Then

MsgBox "Wählen Sie ein Ziellaufwerk aus!", 16, "Problem"

seite = 2

DoCmd.GoToPage seite

Befehl5.Visible = True

Liste1.SetFocus

Befehl28.Visible = False

Exit Sub

End If

596

HINWEIS

Wurde ein Verzeichnis ausgewählt:

laufwerk = UCase(Left$(Liste1.ItemData(Liste1.ListIndex), 1)) & ":\"

If Text29.Value = "" Then

MsgBox "Wählen Sie ein Verzeichnis aus!", 16, "Problem"

seite = 2

DoCmd.GoToPage seite

Befehl5.Visible = True

Text29.SetFocus

Befehl28.Visible = False

Exit Sub

End If

zw = Text29.Value

MkDir zw

If Right$(zw, 1) <> "\" Then zw = zw & "\"

zielpfad = zw

Prüfen, ob schon ein Backup im aktuellen Zielpfad vorhanden ist:

If FileExist(zw & "Backup.ini") Or FileExist(zw & "Backup.mdb") Then

If MsgBox("Im gewählten Verzeichnis befindet sich bereits ein Backup! Überschreiben?", _

36, "Frage") <> 6 Then

seite = 2

DoCmd.GoToPage seite

Befehl5.Visible = True

Liste1.SetFocus

Befehl28.Visible = False

Exit Sub

Else

If FileExist(zw & "Backup.ini") Then Kill zw & "Backup.ini"

If FileExist(zw & "Backup.mdb") Then Kill zw & "Backup.mdb"

End If

End If

zw = CurDir

Nun können wir uns dem eigentlichen Backup-Vorgang zuwenden. Wir erstellen dazu zunächst eine tempo-

räre Datei auf der Festplatte, in die alle ausgewählten Tabellen kopiert werden. Dazu verwenden wir die API-

Funktion

GetTempFileName

, die einen eindeutigen Dateinamen liefert:

temp = Space(255)

GetTempFileName zw, "$$$", 0&, temp

temp = Mid$(temp, 1, InStr(temp, Chr(0)) - 1) & ".mdb"

If FileExist(temp) Then Kill temp

Set ws = DBEngine.Workspaces(0)

Set db = ws.CreateDatabase(temp, dbLangGeneral)

Das Anlegen der temporären Datei hat auch noch einen überaus nützlichen Nebeneffekt: Die Datei wird

automatisch komprimiert, es wird also kein Datenmüll auf dem Backuplaufwerk gespeichert.

db.Close

For i = 1 To UBound(tabellen)

DoCmd.CopyObject temp, tabellen(i), acTable, tabellen(i)

Next i

597

Komplexbeispiel: Datenbank-Backup/-Restore