Data uit bestanden tot een bepaalde datum importeren

Private Sub MT_CopyDataWorkbooksIntoMaster()

Dim FolderPath As String
Dim FileFSO As Object
Dim Filepath As Object
Dim Filename As Object

FolderPath = "C:\Mijn Documenten\Excel\PLANNINGEN - TEST\"

Set FileFSO = CreateObject("Scripting.FileSystemObject")
Set FileFolder = FileFSO.GetFolder(FolderPath)
Set Filepath = FolderPath & "*.xls*"
Set Filename = Dir(Filepath)

Dim lastrow As Long, lastcolumn As Long

Do While Filename <> "" And Format(Filename.DateLastModified, "DD-MM-YYYY") < Format(DateValue("01-12-2017"), "DD-MM-YYYY")
 
'Werkmap openen
Workbooks.Open (FolderPath & Filename), UpdateLinks:=3, Notify:=False
'Alle Kolommen zichtbaar maken
 ActiveSheet.Cells.EntireColumn.Hidden = False
'Laatste Rij vinden
 lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
'Kolommen met ProjectNummer en ProjectNaam
 Columns("A:A").Select
 Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
 Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
 Range("A1").FormulaR1C1 = "=R1C4"
 Range("B1").FormulaR1C1 = "=R2C4"
 Range("A1:B1").AutoFill Destination:=Range(Cells(1, 1), Cells(lastrow, 2)), Type:=xlFillDefault
'Laatste Kolom vinden
 lastcolumn = ActiveSheet.Cells(4, Columns.Count).End(xlToLeft).Column
'Range(“A6:**”) kopieren en werkmap sluiten
 Range(Cells(6, 1), Cells(lastrow, lastcolumn)).Copy
 ActiveWorkbook.Close

erow = Blad1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column

ActiveSheet.Paste Destination:=Worksheets("Blad1").Range(Cells(erow, 1), Cells(erow, lastcolumn))

Filename = Dir

Loop

Private Sub MT_CopyDataFromWorkbooksIntoMaster()

Dim FolderPath As String, Filepath As String, Filename As String

FolderPath = "H:\Mijn Documenten\Excel\PLANNINGEN - TEST\"

Filepath = FolderPath & "*.xls*"

Filename = Dir(Filepath)

Dim lastrow As Long, lastcolumn As Long

Do While Filename <> "" And Format(FileDateTime(Filename), "DD-MM-YYYY") < Format(DateValue("01-11-2017"), "DD-MM-YYYY")

Do While Filename <> "" And FileDateTime(FolderPath & Filename) < (DateValue("2017-11-01")

Sub VenA()
c00 = "H:\Mijn Documenten\Excel\PLANNINGEN - TEST\"
  For Each it In Split(CreateObject("Wscript.Shell").Exec("cmd /c dir """ & c00 & "*.xls*"" /b").StdOut.ReadAll, vbCrLf)
    If it <> "" Then c01 = c01 & it & " " & FileDateTime(c00 & it) & " " & (FileDateTime(c00 & it) < Date - 60) & vbLf
  Next it
  MsgBox c01
End Sub

err.raise 53

Sub test()
  For Each it In ErrObject
    MsgBox it.Number
  Next
End Sub

Option Explicit
Option Base 1
Sub test()
Dim i As Long, sv(746), n As Long
 For i = 1 To 746
   If error(i) <> "Door de toepassing of door object gedefinieerde fout" Then
    n = n + 1
    sv(n) = "foutnummer " & i & vbCrLf & error(i)
  End If
Next i
Cells(1).Resize(n) = Application.Transpose(sv)
End Sub

Sub M_snb()
    sn = Split(CreateObject("wscript.shell").exec("cmd /c dir ""G:\OF\*.csv"" /b/od").stdout.readall, vbCrLf)
    
    ReDim sp(UBound(sn), 1)
    For j = 0 To UBound(sn) - 1
       
      sp(j, 0) = "G:\OF\" & sn(j)
      sp(j, 1) = FileDateTime(sp(j, 0))
      If sp(j, 1) > DateSerial(2016, 1, 1) Then Exit For
    Next
    
    Cells(1, 5).Resize(j, 2) = sp
End Sub

Do While Filename <> "" And Format(FileDateTime(FolderPath & Filename), "DD-MM-YYYY") < Format(DateValue("01-11-2017"), "DD-MM-YYYY")

Sub M_snb()
    msgbox CreateObject("wscript.shell").exec("cmd /c dir ""C:\Mijn Documenten\Excel\PLANNINGEN - TEST\*.csv"" /b/od").stdout.readall
end sub

Do While Filename <> "" And Format(FileDateTime(FolderPath & Filename), "DD-MM-YYYY") < Format(DateValue("01-11-2017"), "DD-MM-YYYY")