CODEWITHSUNDEEP
loopsexcelmkdirvba
Amy Snyder
Amy Snyder

Reputation: 23

Create new folder/file based on time/date

so I'm trying to expand a program where it saves reports, exports them as a pdf, and saves. I've got it to where it can organize the pdf saves into folders by year, and then by month. The issue is, when it comes time for the loop to reach the Day(Date) portion of the code, which saves the file and makes a new folder, but when I try and save another report, it just overwrites the previous one. I've tried adding a Time() or Now() function in there, but it's spitting out errors 75 and 76. Please help.

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

Upvotes: 0

Views: 4297

Answers (1)

Y2Que
Y2Que

Reputation: 113

Try this:

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

Code should read:

 ' 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

Upvotes: 0

Related Questions