Hello all kind people on this forum,
I would really appreciate a minute of your time. I am currently working on the macro below, where I need to open files and run procedures based on the entered TestDate in a Message Box. All works great, except for one condition which I am trying so desperately to incorporate - Bolded and Underlined below.
Specifically, I need to exclude certain files from the loop. In my worksheet, in column AB, I have first 10 characters of the modification dates of the files that need not to be opened by the macro! As you can see, I have been trying COuntif but it does not work, and it just pastes all the files based on my first condition below, i.e. FileDateTime(FolderPath & FileName) >= TestDate .
Could you please kindly let me know whether my approach is the wrong one, and whether it is possible at all to do what I would like it to do? Did I mis-specify something in my code?
I would really appreciate a minute of your time. I am currently working on the macro below, where I need to open files and run procedures based on the entered TestDate in a Message Box. All works great, except for one condition which I am trying so desperately to incorporate - Bolded and Underlined below.
Specifically, I need to exclude certain files from the loop. In my worksheet, in column AB, I have first 10 characters of the modification dates of the files that need not to be opened by the macro! As you can see, I have been trying COuntif but it does not work, and it just pastes all the files based on my first condition below, i.e. FileDateTime(FolderPath & FileName) >= TestDate .
Could you please kindly let me know whether my approach is the wrong one, and whether it is possible at all to do what I would like it to do? Did I mis-specify something in my code?
Code:
Sub OpenByCreationDate()
Call GetDupes
Dim wbk As Workbook
Dim FileName As String
Dim FolderPath As String
Dim TestDate As Variant
Dim TheMax As Date
Dim lastRow As Long
'Dim Count As Integer
Dim RowIndex As Integer
Dim x As Workbook
Dim m As Integer
Set x = ThisWorkbook
RowIndex = 2
FolderPath = "M:\Recca60 COPIES\RECCA60 November\"
FileName = Dir(FolderPath & "*.csv")
EnterDate:
TestDate = InputBox("Enter the file modification date below:", "Find Reports", "DD/MM/YYYY")
If TestDate = "" Then Exit Sub
If Not IsDate(TestDate) Then
MsgBox "The Date you entered is not valid." & vbCrLf _
& "Please enter the date again."
GoTo EnterDate
End If
TestDate = CDate(TestDate)
TheMax = WorksheetFunction.Max(Range("H:H"))
lastRow = ActiveSheet.Cells(Rows.count, "D").End(xlUp).Row
[U][B] m = Application.WorksheetFunction.CountIf(Worksheets("Cash").Range("AB1:AB5"), Left(FileDateTime(FolderPath & FileName), 10))[/B][/U]
If TestDate > TheMax Then
ThisWorkbook.Sheets("Cash").Activate
Sheets("Cash").Range("D2:W" & lastRow).ClearContents
If TestDate < TheMax Then GoTo Update_Values
While FileName <> ""
If FileDateTime(FolderPath & FileName) >= TestDate [B][/B][U]And m = 0 Then[/U]
Set wbk = Workbooks.Open(FolderPath & FileName, ReadOnly, Format:=xlDelimited, Local:=True)
Range("A2:T" & lastRow).Select
Selection.Copy
x.Sheets("Cash").Range("D" & Rows.count).End(xlUp).Offset(1).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'x.Sheets("Cash").Range("X" & RowIndex).End(xlUp).Offset(1).Value = FileDateTime(FolderPath & FileName)
wbk.Close True
Debug.Print "."
End If
RowIndex = RowIndex + 1
FileName = Dir()
Wend
End If
Update_Values:
If TestDate <= TheMax Then
While FileName <> ""
If FileDateTime(FolderPath & FileName) > TheMax + 1 Then
'If TestDate >= FileDateTime(FolderPath & FileName) Then
Set wbk = Workbooks.Open(FolderPath & FileName, ReadOnly, Format:=xlDelimited, Local:=True)
Range("A2:T" & lastRow).Select
Selection.Copy
x.Sheets("Cash").Range("D" & Rows.count).End(xlUp).Offset(1).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'x.Sheets("Cash").Range("X" & RowIndex).End(xlUp).Offset(1).Value = FileDateTime(FolderPath & FileName)
wbk.Close True
Debug.Print "."
End If
RowIndex = RowIndex + 1
FileName = Dir()
Wend
End If
'Call GetDupes
End Sub