VBA Tipp: Dateien kopieren

Aus DBWiki
Wechseln zu: Navigation, Suche

Aufgabenstellung

Eine Datei soll von einem Quellverzeichnis in ein Zielverzeichnis kopiert werden (z.B. Sicherungskopie einer Datenbank erstellen).

Lösung 1

  • Die Datei kann nur kopiert werden, wenn sie geschlossen ist. Wenn die Datei geöffnet ist, tritt ein Fehler auf.
  • Wenn die Datei im Zielverzeichnis bereits existiert, wird sie ohne Vorwarnung überschrieben.
  • Während des Kopiervorgangs wird die Windows-Sanduhr angezeigt.
  • Die Namen der Quelldatei und der Zieldatei dürfen unterschiedlich sein.
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
 
   ' Kopiervorgang erfolgreich
   DateiKopieren = True
 
Exit_DateiKopieren:
   Exit Function
 
Err_DateiKopieren:
 
   ' Fehlermeldungen
   Select Case Err.Number
 
      Case 53   ' Die 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   ' Der Datenträger ist 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

 ' Ohne Rückgabewert
 Call DateiKopieren("C:\Ein Ordner\EinBackend.mdb", _
                    "G:\Datensicherung\EineBackendSicherung.mdb")
 
 ' Rückgabewert auswerten
 If DateiKopieren("C:\Ein Ordner\EinBackend.mdb", _
                  "G:\Datensicherung\EineBackendSicherung.mdb") Then
   MsgBox "Kopieren erfolgreich"
 Else
   MsgBox "Kopieren nicht erfolgreich"
 End If

Lösung 2

  • Die Datei soll zur Laufzeit kopiert werden, d.h. die Datei (z.B. 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.
  • Über das Argument Ueberschreiben kann festgelegt werden, ob eine bereits vorhandene Zieldatei überschrieben werden soll oder nicht.
  • Die Namen der Quelldatei und der Zieldatei dürfen unterschiedlich sein.
  • Während des Kopiervorgangs wird die Windows-Sanduhr angezeigt.
Public Function DateiKopieren(Quelldatei As String, Zieldatei As String, _
                              Optional ByVal Ueberschreiben As Boolean) As Boolean
 
   ' Late Binding, kein Verweis auf die 'Microsoft Scripting Runtime' erforderlich
   ' Quelle: http://www.dbwiki.net/
 
   On Error GoTo Err_DateiKopieren
 
   CreateObject("Scripting.FileSystemObject") _
      .CopyFile Quelldatei, Zieldatei, Ueberschreiben
 
   ' Kopiervorgang erfolgreich
   DateiKopieren = True
 
Exit_DateiKopieren:
   Exit Function
 
Err_DateiKopieren:
   MsgBox "Laufzeitfehler '" & err.Number & "':" & vbCrLf & vbCrLf & err.Description
   Resume Exit_DateiKopieren
 
End Function

Aufruf

 ' Ohne Rückgabewert
 Call DateiKopieren("C:\Ein Ordner\EinBackend.mdb", _
                    "G:\Datensicherung\EineBackendSicherung.mdb")
 
 ' Rückgabewert auswerten
 If DateiKopieren("C:\Ein Ordner\EinBackend.mdb", _
                  "G:\Datensicherung\EineBackendSicherung.mdb", True) Then
   MsgBox "Kopieren erfolgreich"
 Else
   MsgBox "Kopieren nicht erfolgreich"
 End If

Lösung 3

  • Die Datei soll zur Laufzeit kopiert werden, d.h. die Datei (z.B. 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.
  • Wenn die Datei im Zielverzeichnis bereits existiert, wird der Benutzer über eine entsprechende Windows-Dialogbox aufgefordert, zu entscheiden, ob die vorhandene Datei überschrieben werden soll oder nicht.
  • Wenn der Kopiervorgang länger dauert, wird die Windows-Fortschrittsanzeige eingeblendet.
  • Der Name der Quelldatei und der Zieldatei ist gleich.
  • Wenn als Dateiname *.* angegeben wird, werden alle Dateien aus dem Quellordner in den Zielordner kopiert.
  • Wenn der Dateiname weggelassen wird, wird der ganze Quellordner in den Zielordner kopiert.
Public Sub DateiKopieren(QuellDateipfad As String, _
                         ZielOrdner As String)
 
 ' Late Binding, kein Verweis auf 'Microsoft Shell Controls And Automation' erforderlich
 ' Quelle: http://www.dbwiki.net/
 
 Dim objShell   As Object ' Shell32.Shell
 Dim objFolder  As Object ' Shell32.Folder
 
 On Error GoTo Err_DateiKopieren
 
 Set objShell = CreateObject("Shell.Application")
 
 ' Argument in doppelte Klammern bei Late Binding
 Set objFolder = objShell.Namespace((ZielOrdner))
 
 ' Argument in Klammern bei Late Binding
 objFolder.CopyHere (QuellDateipfad)
 
Exit_DateiKopieren:
 Exit Sub
 
Err_DateiKopieren:
 
 ' Wenn Fehler 91: 'Objektvariable oder With-Blockvariable nicht festgelegt'
 If Err.Number = 91 Then
   MsgBox "Der Pfad zum Zielordner '" & ZielOrdner & "' ist ungültig."
 Else
   ' Standard-Fehlermeldung
   MsgBox "Laufzeitfehler '" & Err.Number & "':" & vbCrLf & vbLf & Err.Description
 End If
 
 Resume Exit_DateiKopieren
 
End Sub

Aufruf

 ' Datei kopieren
 Call DateiKopieren("C:\Ein Ordner\EinBackend.mdb", "G:\Datensicherung\")
 
 ' Alle Dateien aus dem Quellordner in den Zielordner kopieren
 Call DateiKopieren("C:\Ein Ordner\Ein Unterordner\*.*", "G:\Ein Anderer Ordner\")
 
 ' Einen ganzen Ordner kopieren
 Call DateiKopieren("C:\Ein Ordner\Ein Unterordner", "G:\Ein Anderer Ordner\")

Wikilinks

Weblinks