'<META name="Description" content="Add In 'Datensicherung C' für Access 2000">
'DEKLARATION

Option Compare Database
Option Explicit


'1.F U N K T I O N

Function strt()
Dim antw%
antw = MsgBox("Soll die Datenbank auf Laufwerk C: gesichert werden ?", vbYesNo + vbQuestion, "DATENSICHERUNG")
If antw = vbYes Then
DoCmd.Minimize
datensicherungC
Else
DoCmd.Quit acQuitSaveAll
Exit Function
End If
DoCmd.Quit
End Function

'2.F U N K T I O N

Function datensicherungC()
Dim verz$
Dim antw%
Dim dbName As String, dbNameKurz As String
Dim fs As New FileSystemObject
Dim fehlerNr As Integer
Const VerzSich = "C:\DB\SICHERUNG\"
alleSchließen
fehlerNr = 0
On Error GoTo fehler
Application.Echo True, "Die Datenbank wird gesichert..."
dbName = Application.CurrentDb.Name
dbNameKurz = fs.GetFileName(dbName)
If FileExists("SICHERUNG", "C:\DB\") = False Then
MkDir "c:\DB\SICHERUNG"
End If
verz = CStr(Month(Date)) & "_" & CStr(Year(Date))
If FileExists(verz, VerzSich) = False Then
MkDir VerzSich & verz
End If
If FileExists(dbNameKurz, VerzSich & verz & "\") = True Then
antw = MsgBox("Soll die vorhandene Datei überschrieben werden ?", vbQuestion + vbYesNo, "Datei ersetzen ?")
If antw = vbYes Then
Kill VerzSich & verz & "\" & dbNameKurz
Else
MsgBox "Datensicherung wurde abgebrochen !", vbInformation, "Vorgang beendet !"
Exit Function
End If
End If
fs.copyfile dbName, VerzSich & verz & "\X_" & dbNameKurz, True
Application.DBEngine.CompactDatabase VerzSich & verz & "\X_" & dbNameKurz, VerzSich & verz & "\" & dbNameKurz
fs.DeleteFile VerzSich & verz & "\X_" & dbNameKurz, True
Application.Echo True, ""
Exit Function
fehler:
fehlerNr = fehlerNr + 1
If Err.Number = 75 Then
Resume Next
ElseIf fehlerNr <= 5 Then
Resume
ElseIf fehlerNr> 5 Then
MsgBox Err.Number & " -> " & Err.Description
End If
End Function

'3. F U N K T I O N = Sub Prozedur

Sub alleSchließen()
Dim rs As Recordset
Dim frm As Form
For Each rs In CurrentDb.Recordsets
rs.Close
Next rs
End Sub

'4.F U N K T I O N

Function FileExists(Datei$, Optional Verzeichnis) As Boolean
With Application.FileSearch
.FileName = Datei
If IsMissing(Verzeichnis) = False Then
.LookIn = Verzeichnis
Else
.LookIn = CurDir()
End If
.SearchSubFolders = False
.Execute
If .FoundFiles.Count> 0 Then
FileExists = True
Else
FileExists = False
End If
End With
End Function