Macro code to save a file to a folder titled as of current day, prior day, or two days prior

Question

I am working on a macro that saves a tab from a workbook as a CSV file in the current year, month, and day’s folder on a drive. If any of the folders do not exist, the macro creates them. This process is run twice a week on Monday, Tuesday, and sometimes Wednesday. I would like for the code to not only look for the current day’s folder, but also look for last two consecutive day’s folders before creating a new one. The goal is for all files created on Monday,Tuesday and Wednesday to be saved in the Monday date folder. The below code works for creating a current day’s folder to save to. I need help adding code to first look for a folder dated as two days prior, then if that date isn't found search for one day prior, then finally if the first two dates are not found, search for the current day before creating a new folder. Thanks!

'Save new file to correct folder based on the current date.  If no folder exists, the formula creates its own folder.  Files are saved as CSV files.
Dim strGenericFilePath      As String: strGenericFilePath = "W:\"
Dim strYear                 As String: strYear = Year(Date) & "\"
Dim strMonth                As String: strMonth = Format(Date, "MM - ") & MonthName(Month(Date)) & "\"
Dim strDay                  As String: strDay = Format(Date, "MM-DD") & "\"
Dim strFileName             As String: strFileName = "Res-Rep Brinks_Armored Entries - " & Format(Date, "MM-DD-YYYY")

Application.DisplayAlerts = False

' Check for year folder and create if needed.
If Len(Dir(strGenericFilePath & strYear, vbDirectory)) = 0 Then
    MkDir strGenericFilePath & strYear
End If

' Check for month folder and create if needed.
If Len(Dir(strGenericFilePath & strYear & strMonth, vbDirectory)) = 0 Then
    MkDir strGenericFilePath & strYear & strMonth
End If

' Check for date folder and create if needed.
If Len(Dir(strGenericFilePath & strYear & strMonth & strDay, vbDirectory)) = 0 Then
    MkDir strGenericFilePath & strYear & strMonth & strDay
End If

' Save File
 ActiveWorkbook.SaveAs Filename:= _
 strGenericFilePath & strYear & strMonth & strDay & strFileName, _
 FileFormat:=xlCSV, CreateBackup:=False

Sam Sam · Accepted Answer · 2018-09-17T16:30:39

Here is a little function that might help you:

Function MondayOfWeek(InDate As Date) As Date
    Dim DayOfWeek As Integer
    DayOfWeek = DatePart("w", InDate, vbMonday)
    MondayOfWeek = DateAdd("d", InDate, -(DayOfWeek - 1))
End Function

If finds out what day of the week the provided date has and subtracts that number. Use it like this:

strDay = Format(MondayOfWeek(Date), "MM-DD") & "\"

Macro code to save a file to a folder titled as of current day, prior day, or two days prior

1 Answers