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:
 
   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.
  • Während des Kopiervorgangs wird die Windows-Sanduhr angezeigt.
  • Die Namen der Quelldatei und der Zieldatei dürfen unterschiedlich sein.
Public Function DateiKopieren(Quelldatei As String, Zieldatei As String, _
                              Optional ByVal Ueberschreiben As Boolean) As Boolean
 
   ' Datei zur Laufzeit kopieren
   ' 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 die 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 für den Kopiervorgang eingeblendet.
  • Die Namen der Quelldatei und der Zieldatei sind gleich.
  • Wenn der Dateiname weggelassen wird, wird der ganze Quellordner in den Zielordner kopiert.
  • Wenn als Dateiname *.* angegeben wird, werden alle Dateien aus dem Quellordner in den Zielordner kopiert.
Public Sub DateiKopieren(QuellDateipfad As String, ZielOrdner As String)
 
 ' Datei zur Laufzeit kopieren
 ' 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")
 
 ' Bei Late Binding 'ZielOrdner' in doppelte Klammern setzen
 Set objFolder = objShell.Namespace((ZielOrdner))
 
 ' Bei Late Binding 'QuellDateipfad' in Klammern setzen
 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\")
 
 ' Ganzen Ordner kopieren
 Call DateiKopieren("C:\Ein Ordner\", "G:\Datensicherung\")
 
 ' Alle Dateien aus dem Ordner kopieren
 Call DateiKopieren("C:\Ein Ordner\*.*", "G:\Datensicherung\")

Wikilinks

Weblinks