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

时间:2015-06-03 17:39:23

标签: loops excel-vba mkdir vba excel

所以我正在尝试扩展一个保存报告的程序,将它们导出为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"

End Sub

1 个答案:

答案 0 :(得分:0)

试试这个:

"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