用于将文件保存到标题为截至当天、前一天或前两天的文件夹的宏代码
用于将文件保存到标题为截至当天、前一天或前两天的文件夹的宏代码
提问于 2018-09-17 23:11:58
我正在处理一个宏，它将工作簿中的选项卡另存为驱动器上当前年、月、日文件夹中的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:=FalseStack Overflow用户
发布于 2018-09-18 00:30:39
下面是一个可能对您有帮助的小函数：
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") & "\"页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/52370849
复制相关文章
相似问题
腾讯云开发者
