根据时间/日期创建新文件夹/文件

Question

所以我正在尝试扩展一个程序，它可以保存报告、将它们导出为 pdf 并保存。我已经把它放在可以按年组织pdf保存到文件夹中的地方，然后按月。问题是，当循环到达代码的Day(Date) 部分时，它会保存文件并创建一个新文件夹，但是当我尝试保存另一个报告时，它只会覆盖前一个报告。我尝试在其中添加 Time() 或 Now() 函数，但它会吐出错误 75 和 76。请帮忙。

Sub Date_Folder_Save()  

Application.DisplayAlerts = False   

 ' Check for year folder and create if needed
If Len(Dir("C:blah\" & Year(Date), vbDirectory)) = 0 Then
    MkDir "C:blah\" & Year(Date)
End If


 ' Check for month folder and create if needed
If Len(Dir("C:blah\" & Year(Date) & "\" & MonthName(month(Date), False), vbDirectory)) = 0 Then
    MkDir "C:blah\" & Year(Date) & "\" & MonthName(month(Date), False)
End If

  ' Check for day folder and create if needed
If Len(Dir("C:blah\" & Year(Date) & "\" & MonthName(month(Date), False) & "\" & Day(Date), vbDirectory)) = 0 Then
    MkDir "C:blah\" & Year(Date) & "\" & MonthName(month(Date), False) & "\" & Day(Date)
End If

' Check for time
If Len(Dir("C:blah\" & Year(Date) & "\" & MonthName(month(Date), False) & "\" & Day(Date) & "\" & Now(), vbDirectory)) = 0 Then
    MkDir "C:blah\" & Year(Date) & "\" & MonthName(month(Date), False) & "\" & Day(Date) & "\" & Now()
End If

 ' Save File
ActiveSheet.ExportAsFixedFormat Type:=x1TypePDF, Filename:= _
"C:blah\" & Year(Date) & "\" & MonthName(month(Date), False) & "\" & Format(Date, "mm.dd.yy") & ".pdf" _
, Quality:=x1QualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True _
, CreateBackup:=False



Application.DisplayAlerts = True

 ' Popup Message
MsgBox "File Saved As:" & vbNewLine & "blah\" & Year(Date) & _
"\" & MonthName(month(Date), False) & "\" & Format(Date, "mm.dd.yy") & ".pdf"

结束子

Answer 1

试试这个：

"C:blah\" & Year(Date) & "\" & MonthName(month(Date), False) & "\" & _
            Format(Now(), "mm.dd.yy_hh.mm.ssAM/PM") & ".pdf" )

代码应为：

 ' Save File
strFilePath = "C:blah\" & Year(Date) & "\" & MonthName(month(Date), False) & "\" & _
              Format(Now(), "mm.dd.yy_hh.mm.ssAM/PM") & ".pdf" )


ActiveSheet.ExportAsFixedFormat Type:=x1TypePDF, Filename:= strFilePath,  _
                                Quality:=x1QualityStandard, IncludeDocProperties:=True, _
                                IgnorePrintAreas:=False, OpenAfterPublish:=True, _
                                CreateBackup:=False

Application.DisplayAlerts = True

 ' Popup Message
MsgBox "File Saved As:" & vbNewLine & strFilePath