Verschieben von Ordnern mit dem FSO Diese Funktion verschiebt einen vorhandenen Ordner mitsamt Unterordner in ein anderes Verzeichnis, wobei das Zielverzeichnis ggf. zunächst erstellt wird, falls nicht vorhanden.
Autor:   Wilhelm Reikamp	Bewertung:     [ Jetzt bewerten ]	Views:  4.306
ohne Homepage	System:  Win9x, WinNT, Win2k, WinXP, Vista, Win7	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 3 Bewertung insgesamt: sehr gut Durchschnittliche Bewertung: 4.7 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Mit nachfolgender Funktion lässt sich ein Ordner mitsamt allen vorhandenen Unterordner in ein neues Verzeichnis verschieben, wobei das Zielverzeichnis ggf. vorher erstellt wird, falls dieses noch nicht existiert.

' Verschieben von Ordner mittels FSO
' mit autom. Erstellung von verschachtelten
' Verzeichnissesn im Zielordner
Public Function MoveFolder(ByVal Source As String, _
  ByVal Dest As String, _
  Optional ByVal bOverwrite As Boolean = False) As Boolean
 
  ' Paramterliste:
  '   Source:     Quellordner
  '   Dest:       Zielordner
  '   bOverwrite: Optional.
  '               Vorhandene Dateien überschreiben ja/nein
 
  On Error Resume Next
 
  Dim aStrFolder() As String
  Dim i As Integer
  Dim strParentFolder As String
  Dim bFolderBenoetigt As Boolean
 
  ' FSO-Objekt erstellen
  Dim FSO As Object
  Set FSO = CreateObject("Scripting.FileSystemObject")
 
  ' Wenn Zielverzeichnis bereits vorhanden...
  If FSO.FolderExists(Dest) And FSO.FolderExists(Source) Then
    ' ... nur wenn Parameter bOverwrite = True
   If bOverwrite = True Then
     ' Ordner kopieren
      FSO.CopyFolder Source, Dest, True
 
      ' Quellordner löschen
      FSO.DeleteFolder Source, True
    End If
 
  ElseIf FSO.FolderExists(Source) Then
    ' zunächst Zielverzeichnis erstellen
    strParentFolder = FSO.GetParentFolderName(Dest)
    i = 0
    Do While Not FSO.FolderExists(strParentFolder)
      ReDim Preserve aStrFolder(i)
      aStrFolder(i) = strParentFolder
      i = i + 1
      strParentFolder = FSO.GetParentFolderName(strParentFolder)
      bFolderBenoetigt = True
    Loop
    If bFolderBenoetigt And i = 0 Then
      FSO.CreateFolder aStrFolder(i)
    ElseIf bFolderBenoetigt And i > 0 Then
      For i = UBound(aStrFolder) To LBound(aStrFolder) Step -1
        FSO.CreateFolder aStrFolder(i)
      Next
    End If
    ' jetzt Ordner verschieben
    FSO.MoveFolder Source, Dest
 
  Else
    ' Quellordner existiert nicht!
    MoveFolder = False
    Exit Function
  End If
 
  If FSO.FolderExists(Dest) And Not FSO.FolderExists(Source) Then
    MoveFolder = True
  Else
    MoveFolder = False
  End If
 
  On Error GoTo 0
End Function

Anwendungsbeispiel:

' Ordner d:\temp mitsamt Unterordner auf Laufwerk
' e: in das Verzeichnis \temp\test verschieben, wobei das 
' Zielverzeichnis autom. erstellt wird, falls nicht vorhanden
MoveFolder "d:\temp", "e:\temp\test"