Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1688to1692
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Dateien aus Ordner kopieren

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
Anzeige
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
Anzeige
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

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige