Dateien aus Ordner kopieren

Forumthread: Dateien aus Ordner kopieren

21.04.2019 15:51:35

Michael

Hallo Zusammen
ich scheitere an folgender Aufgabenstellung:
In einem Verzeichnis (z.B.: Test) sind sehr viele Ordner hinterlegt.
Alle Ordner haben als Namen ein Tagesdatum im Format:JJJJMMTT!
In Tabelle1 in der Zelle A1 ist ein Datum hinterlegt(Name der Zelle: Datum_Max).
Ich benötige nun aus allen Ordner, deren Datum Größer als Datum_Max ist, die darin enthaltenen Dateien (in der Regel eine Datei, maximal 3 Dateien).
Die Dateien sollen in das Verzeichnis Ziel kopiert werden.
Ist das aus Excel heraus mit VBA überhaupt möglich?
Vielen Dank für Eure Unterstützung und noch einen sonnigen (Rest)Sonntag!
Gruß
Michael

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Dateien aus Ordner kopieren

21.04.2019 16:35:10

Nepumuk
Perfekt!

21.04.2019 16:53:14

Michael

AW: Dateien aus Ordner kopieren

21.04.2019 16:35:10

Nepumuk

Hallo Michael,
in ein normale Modul:

Option Explicit

Public Sub CopyFiles()
    Const INPUT_FOLDER As String = "H:\Test\" ' anpassen !!!
    Const OUTPUT_FOLDER As String = "H:\Ziel\" ' anpassen !!!
    Dim strFolderName As String, astrFolders() As String
    Dim strFileName As String
    Dim ialngFolderCount As Long, ialngFolderIndex As Long
    Dim dtmTempDate As Date, dtmMaxDate As Date
    dtmMaxDate = Worksheets("Tabelle1").Range("Datum_Max").Value ' Tabellenname anpassen !!!
    strFolderName = Dir$(PathName:=INPUT_FOLDER & "*", Attributes:=vbDirectory)
    Do Until strFolderName = vbNullString
        If GetAttr(PathName:=INPUT_FOLDER & strFolderName) And vbDirectory Then
            If strFolderName Like "########" Then
                dtmTempDate = DateSerial(Year:=CInt(Left$(strFolderName, 4)), _
                    Month:=CInt(Mid$(strFolderName, 5, 2)), Day:=CInt(Mid$(strFolderName, 7, 2)))
                If dtmTempDate > dtmMaxDate Then
                    Redim Preserve astrFolders(ialngFolderCount)
                    astrFolders(ialngFolderCount) = INPUT_FOLDER & strFolderName & "\"
                    ialngFolderCount = ialngFolderCount + 1
                End If
            End If
        End If
        strFolderName = Dir$
    Loop
    If ialngFolderCount > 0 Then
        For ialngFolderIndex = 0 To ialngFolderCount - 1
            strFileName = Dir$(PathName:=astrFolders(ialngFolderIndex) & "*.*")
            Do Until strFileName = vbNullString
                Call FileCopy(Source:=astrFolders(ialngFolderIndex) & strFileName, _
                    Destination:=OUTPUT_FOLDER & strFileName)
                strFileName = Dir$
            Loop
        Next
    Else
        Call MsgBox("Keinen Ordner gefunden.", vbExclamation, "Hinweis")
    End If
End Sub

Gruß
Nepumuk

Perfekt!

21.04.2019 16:53:14

Michael

Hallo Nepumuk,
vielen Dank für Deine schnelle Antwort.
Funktioniert perfekt und ist sehr schnell.
DANKE!
Ich wünsche Dir noch einen erholsamen Sonntag.
Gruß
Michael

Beliebteste Forumthreads (12 Monate)

Forumthread: Dateien aus Ordner kopieren

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread