Public Function Save_BE(strPath As String, strDBNameBE As String, intOutput As Integer, _
Optional sPW As String = \"\"«») As Boolean
'Public Function Save_BE(strPath As String, strDBNameBE As String, intOutput As Integer) As Boolean
'*******************************************
'Name: Save_BE (Function)
'Purpose: sichert eine Backend in ein Backup-Verzeichnis mit ini-Datei
'Author: Tommyk
'Date: Juni 11, 2004, 04:40:55
'Inputs: strPath=Pfad des Backupverzeichnisses,strDBNameBE=Name und Pfad des Backends
' intOutput= Art der Ausgabe (1=MDB, 2=ZIP)
'Output: True = Erfolgreich, False = Fehler
'*******************************************
On Error GoTo FehlerBackup
Dim strEndung As String, strDBFile As String, str_TempBE As String
Dim strSaveBE_Path As String
Dim F As Integer, strDB_BE As String
Dim vardummydatei As Variant
Dim vardummypfad As Variant
Save_BE = False
strEndung = Format(Date, \"ddd\"«»)
strDB_BE = strDBNameBE
strDBFile = \"\\" & DateiName(strDB_BE, True)
strSaveBE_Path = BackSlash(strPath, True) & strEndung
str_TempBE = BackSlash(strPath, True) & \"BE_Temp\"
DoCmd.SetWarnings False
DoCmd.Hourglass True
' Wenn Verzeichnisse nicht existieren, erstellen
If DoesDirExist(strSaveBE_Path) = False Then MkDir strSaveBE_Path
If DoesDirExist(str_TempBE) = False Then MkDir str_TempBE
Application.Echo True, \"Bitte warten , Datei: \" & strDBNameBE & \" ,wird nach \" & strSaveBE_Path & \" gesichert.\"
' Backup ins Temp-Verzeichnis kopieren
CopyFileFSO strDBNameBE, str_TempBE & strDBFile
F = FreeFile
' INI Datei schreiben
Open str_TempBE & \"\Backup.ini\" For Output As F
Print #F, CStr(str_TempBE & strDBFile)
Print #F, CStr(strSaveBE_Path & strDBFile)
Print #F, Date
Print #F, Time
If intOutput = 1 Then
Print #F, CStr(\"MDB\"«»)
Else
Print #F, CStr(\"ZIP\"«»)
End If
Close #F
' Backup komprimieren
Application.Echo True, \"Bitte warten , Datenbank wird komprimiert ...\"
vardummypfad = BackSlash(str_TempBE, True)
vardummydatei = vardummypfad & \"Dummy.mdb\"
[color=#FF0000]DBEngine.CompactDatabase str_TempBE & strDBFile, vardummydatei, , , \";pwd=\" & sPW
'DBEngine.CompactData_base_str_TempBE & strDBFile, vardummydatei, , , \";pwd=\" & sPW[/color]
Kill str_TempBE & strDBFile
Name vardummydatei As str_TempBE & strDBFile
' wenn kein Fehler, dann in das WT-Backupverzeichnis im Tempverzeichnis in das Backupverzeichnis kopieren
CopyFileFSO str_TempBE & strDBFile, strSaveBE_Path & strDBFile
CopyFileFSO str_TempBE & \"\Backup.ini\", strSaveBE_Path & \"\Backup.ini\"
DoCmd.SetWarnings True
DoCmd.Hourglass False
Save_BE = True
ExitHere:
DoCmd.Hourglass False
Exit Function
FehlerBackup:
DoCmd.Hourglass False
If Err = 76 Or Err = 3044 Then
MsgBox \"Netzwerkpfad konnte nicht gefunden werden.\" & vbNewLine & \"Daten werden nicht gesichert.\" & vbNewLine & \"Vorgang wird beendet.\", vbOKOnly + vbCritical, \"Netzwerk\"
ElseIf Err = 3196 Or Err = 70 Then
MsgBox \"Die Datenbank wird zur Zeit verwendet.\" & vbNewLine & \"Daten werden nicht gesichert.\" & vbNewLine & \"Vorgang wird beendet.\", vbOKOnly + vbCritical, \"Datenbenutzung\"
ElseIf Err = 53 Or Err = 3024 Or Err = 3005 Then
MsgBox \"Datei konnte nicht gefunden werden.\" & vbNewLine & \"Daten werden nicht gesichert.\" & vbNewLine & \"Vorgang wird beendet.\", vbOKOnly + vbCritical, \"Dateizugriff\"
Else
Dim strErrString As String
strErrString = \"Error Information...\" & vbCrLf
strErrString = strErrString & \"Error#: \" & Err.Number
strErrString = strErrString & \" Description: \" & Err.Description
MsgBox strErrString, vbCritical + vbOKOnly, \"Function: Save_BE\"
End If
Resume ExitHere
End Function
