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 soll zur Laufzeit kopiert werden.
    • Die Datei wird auch kopiert, wenn sie geöffnet ist.
    • Ob die Sicherung eines Backends, das geöffnet ist, sinnvoll ist, mag jeder selbst entscheiden. Wenn gerade Daten geschrieben / gelöscht / verändert werden, sichert man sich eventuell ein kaputtes Backup, und erfährt nichts davon.
  • Lösung 2:
    • Die Datei kann nur kopiert werden, wenn sie geschlossen ist.
    • Wenn die Datei geöffnet ist, tritt ein Fehler auf.

Lösung 1

Public Function DateiKopieren(Quelldatei As String, Zieldatei As String)
 
 'Datei zur Laufzeit kopieren
 'Late Binding, kein Verweis auf die Microsoft Scripting Runtime notwendig
 'Quelle: www.dbwiki.net oder www.dbwiki.de
 
 Dim objFso As Object 'FileSystemObject
 
 On Error GoTo Err_DateiKopieren
 
 Set objFso = CreateObject("Scripting.FileSystemObject")
 
 objFso.CopyFile Quelldatei, Zieldatei, True
 
Exit_DateiKopieren:
 Set objFso = Nothing
 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")


Lösung 2

Public Function DateiKopieren(Quellpfad As String, Zielpfad As String) As Boolean
 
 'FileCopy funktioniert nur mit geschlossenen Dateien.
 'Quelle: www.dbwiki.net oder www.dbwiki.de
 
 Dim meldung As String
 
 'Rückgabewert der Funktion
 DateiKopieren = False
 
 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")

Wiki-Links

Web-Links