Ordner mit Tagesdatum und Uhrzeit erstellen VBS

' Quellpfad der zu sichernden Dateien angeben  
    Const Quelle = "C:\TEST"  

    ' Ziel der Sicherung angeben  
    Const Ziel = "Y:\Test\"  


    Dim FS, WSH, Anzahl
    Const Titel = "Automatische Datensicherung"  

    Set FS = CreateObject("Scripting.FileSystemObject")  
    Set WSH = CreateObject("WScript.Shell")  

    On Error Resume Next

    PfadTesten Quelle
    PfadTesten Ziel

    Anzahl = 0

    DateiSystemDurchsuchen Quelle

    WSH.PopUp Anzahl & " Datei(en) von " & Quelle & " nach " & Ziel _  
            & " gesichert", 5, Titel, vbOKOnly + vbCritical  

    ' *** Ende des Skripts  



    ' ---------------------------------------------------------- '  
    ' Rekursives Unterprogramm um das Dateisystem zu durchsuchen  
    ' ---------------------------------------------------------- '  

    Private Sub DateiSystemDurchsuchen(Pfad)
        Dim Ordner, UnterOrdner, Datei

        If FS.FolderExists(Pfad) Then
            ' Then: Falls Ordner übergeben wurde  
            Set Ordner = FS.GetFolder(Pfad)

            ' Papierkorb nicht bearbeiten  
            If LCase(Ordner.Name) = "recycled" Then Exit Sub  

            ' Funktion Bearbeiten() für Ordner aufrufen  
            Bearbeiten Ordner, False

            ' Alle Dateien im Ordner bearbeiten  
            For Each Datei In Ordner.Files
                ' Prozedur Bearbeiten() für Dateien aufrufen  
                Bearbeiten Datei, True
            Next

             ' Alle Unterordner rekursiv bearbeiten  
            For Each UnterOrdner In Ordner.SubFolders
                ' Einstieg In die Rekursion  
                DateiSystemDurchsuchen UnterOrdner
            Next

        ElseIf FS.FileExists(Pfad) Then
            ' Else: Falls eine einzelne Datei übergeben wurde  
            Bearbeiten FS.GetFile(Pfad), True
        End If
    End Sub

    ' Hier wird festgelegt, wie Dateien bearbeitet werden sollen.  
    Private Function Bearbeiten(Datei, IstDatei)
        Dim ZielPfad
        ' Schreibschutz-Attribut einer/s Datei/Ordners löschen  
        ZielPfad = Ziel & Mid(Datei.Path, Len(Quelle) + 1)
        If IstDatei Then
            If (Datei.Attributes And 32) Then
                Anzahl = Anzahl + 1
                Bearbeiten = True
                Datei.Attributes = Datei.Attributes And Not 32
                Datei.Copy ZielPfad, True
            End If
        Else
            If Not FS.FolderExists(ZielPfad) Then FS.CreateFolder ZielPfad
        End If
    End Function


    Private Sub PfadTesten(Pfad)
        Dim TempPfad

        ' Existiert das Laufwerk ?  
        TempPfad = FS.GetDriveName(Pfad)
        If Not FS.DriveExists(TempPfad) Then
            WSH.PopUp "Laufwerk " & TempPfad & " existiert nicht", 5, Titel, vbCritical  
            WScript.Quit
        ElseIf Not FS.Drives(TempPfad).IsReady Then
            MsgBox "Kein Medium In Laufwerk " & TempPfad & " eingelegt", vbCritical, Titel  
            WScript.Quit
        End If

        ' Existiert der Pfad ? Falls Nein, Pfad aufbauen  
        Pfad = Trim(Pfad)
        If Right(Pfad, 1) <> "\" Then Pfad = Pfad & "\"  
        TempPfad = Pfad
        While Not FS.FolderExists(TempPfad)
            If FS.FolderExists(FS.GetParentFolderName(TempPfad)) Then
                FS.CreateFolder TempPfad
                ' Konnte Pfad erstellt werden ?  
                If Not FS.FolderExists(TempPfad) Then
                    MsgBox "Pfad '" & TempPfad & "' kann nicht erstellt werden", vbCritical, Titel  
                    WScript.Quit
                End If
                TempPfad = Pfad
            Else
                TempPfad = FS.GetParentFolderName(TempPfad)
            End If
        Wend
    End Sub