VBA Tipp: Dateien kopieren

Aus DBWiki
Wechseln zu: Navigation, Suche

Aufgabenstellung

Eine Datei soll kopiert werden, z.B. soll eine Sicherungskopie einer Datenbank bzw. eines Backends angelegt werden.

Lösung 1

Die Datei kann nur kopiert werden, wenn sie geschlossen ist. Wenn die Datei geöffnet ist, tritt ein Fehler auf.

Public Function DateiKopieren(Quellpfad As String, Zielpfad As String) As Boolean
 
   ' FileCopy funktioniert nur mit geschlossenen Dateien.
   ' Quelle: http://www.dbwiki.net/
 
   Dim meldung As String
 
   On Error GoTo Err_DateiKopieren
 
StarteKopieren:
 
   ' Datei kopieren
   FileCopy Quellpfad, Zielpfad
 
   ' Backup erfolgreich
   DateiKopieren = True
 
Exit_DateiKopieren:
   Exit Function
 
Err_DateiKopieren:
 
   Select Case Err.Number
 
      Case 53   ' Datei existiert nicht oder Dateiname falsch
         meldung = "Laufzeitfehler '" & Err.Number & "':" & vbCrLf & vbCrLf & _
                   "Die Datei existiert nicht im angegebenen Ordner." & vbCrLf & _
                   "oder der Dateiname ist falsch geschrieben."
 
         MsgBox meldung, vbExclamation Or vbOKCancel
         Resume Exit_DateiKopieren
 
 
      Case 61   ' Datenträger voll
         meldung = "Laufzeitfehler '" & Err.Number & "':" & vbCrLf & vbCrLf & _
                   "Der Datenträger ist voll." & vbCrLf & _
                   "Bitte einen leeren Datenträger einlegen."
 
         If MsgBox(meldung, vbExclamation + vbOKCancel) = vbOK Then
            Resume StarteKopieren
         Else
            Resume Exit_DateiKopieren
         End If
 
 
      Case 70   ' Die Datei ist geöffnet
         meldung = "Laufzeitfehler '" & Err.Number & "':" & vbCrLf & vbCrLf & _
                   "Die zu sichernde Datei ist noch geöffnet." & vbCrLf & _
                   "Bitte die Datei zuerst schließen, und dann nochmal versuchen."
 
         MsgBox meldung, vbExclamation + vbOKCancel
         Resume Exit_DateiKopieren
 
 
      Case 71   ' Das Laufwerk enthält keinen Datenträger
         meldung = "Laufzeitfehler '" & Err.Number & "':" & vbCrLf & vbCrLf & _
                   "Das Laufwerk enthält keinen Datenträger." & vbCrLf & _
                   "Bitte zuerst einen neuen Datenträger einlegen."
 
         If MsgBox(meldung, vbExclamation + vbOKCancel) = vbOK Then
            Resume StarteKopieren
         Else
            Resume Exit_DateiKopieren
         End If
 
 
      Case 75, 76   ' nur Ordnerpfad angegeben, Dateiname fehlt
         meldung = "Laufzeitfehler '" & Err.Number & "':" & vbCrLf & vbCrLf & _
                   "Der Pfad enthält keinen Dateinamen."
 
         MsgBox meldung, vbExclamation + vbOKCancel
         Resume Exit_DateiKopieren
 
 
      Case Else
         MsgBox "Laufzeitfehler '" & Err.Number & "':" & vbCrLf & vbCrLf & Err.Description
         Resume Exit_DateiKopieren
 
   End Select
 
End Function

Aufruf

   Call DateiKopieren("C:\Mein Ordner\MeinBackend.mdb", _
                      "G:\Datensicherung\MeineBackendSicherung.mdb")

Lösung 2

Die Datei soll zur Laufzeit kopiert werden. Die Datei wird auch kopiert, wenn sie geöffnet ist.

Wiki warning.png

Warnung:

  • Die Datei (Datenbank) wird auch kopiert, wenn sie geöffnet ist.
  • Ob das Kopieren einer Datenbank, die geöffnet ist, sinnvoll ist, mag jeder selbst entscheiden. Wenn gerade Daten geschrieben, gelöscht oder geändert werden, sichert man sich eventuell eine defekte Datenbank und erfährt nichts davon.


Public Function DateiKopieren(Quelldatei As String, Zieldatei As String, _
                              Optional ByVal Ueberschreiben As Boolean)
 
   ' Datei zur Laufzeit kopieren
   ' Late Binding, kein Verweis auf die Microsoft Scripting Runtime notwendig
   ' Quelle: http://www.dbwiki.net/
 
 
   On Error GoTo Err_DateiKopieren
 
   CreateObject("Scripting.FileSystemObject") _
      .CopyFile Quelldatei, Zieldatei, Ueberschreiben
 
Exit_DateiKopieren:
   Exit Function
 
Err_DateiKopieren:
   MsgBox "Laufzeitfehler '" & Err.Number & "':" & vbCrLf & vbCrLf & Err.Description
   Resume Exit_DateiKopieren
End Function

Aufruf

   Call DateiKopieren("C:\Mein Ordner\MeinBackend.mdb", _
                      "G:\Datensicherung\MeineBackendSicherung.mdb", True)

Wikilinks

Weblinks