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