用于将文件保存到标题为当天、前一天或两天前的文件夹的宏代码

Question

我正在处理一个宏，该宏将工作簿中的选项卡保存为驱动器上当前年，月和日的文件夹中的CSV文件。如果任何文件夹不存在，宏将创建它们。 此过程每周运行两次，分别在星期一、星期二，有时在星期三运行。我希望代码不仅要查找当天的文件夹，还要在创建新文件夹之前查找连续两天的文件夹。目标是将星期一，星期二和星期三创建的所有文件保存在星期一日期文件夹中。 以下代码用于创建要保存到的当天文件夹。我需要帮助添加代码以首先查找日期为两天前的文件夹，然后如果未找到该日期，则搜索前一天，最后如果找不到前两个日期，请在创建新文件夹之前搜索当天。谢谢！

'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

Answer 1

这里有一个小函数可能会帮助你：

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

如果找出提供的日期在一周中的哪一天并减去该数字。 像这样使用它：

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