VBA to save File to Folder of Current Month

[kwooden0626]

Hello All,

I have a VBA that will save the current workbook to a folder for the current year and month. It will first check to see if the folder already exists and if it doesn't it will create it prior to saving. My problem is that I created my folder structure using the month number and name so that the folders sort in the correct month order (i.e. 01. January, 02. February, etc.).

I tried to tweak this code by using MonthNumber(Month(Date) but this did not work. I receive an error stating "Sub or funtion not defined" and it highlights "MonthNumber."

Below is the full code I tried using.



If Len(Dir("C:\Documents\01 Leidos\01 Admin Ops\01 Daily Operations\01. Reports\04 Contractor PERSTAT", vbDirectory)) = 0 Then
MkDir "C:\Documents\01 Leidos\01 Admin Ops\01 Daily Operations\01. Reports\04 Contractor PERSTAT"
End If



' 'Save Report Part 2: Check for year folder and create if needed
If Len(Dir("C:\Documents\01 Leidos\01 Admin Ops\01 Daily Operations\01. Reports\04 Contractor PERSTAT" & Year(Date), vbDirectory)) = 0 Then
MkDir "C:\Documents\01 Leidos\01 Admin Ops\01 Daily Operations\01. Reports\04 Contractor PERSTAT" & Year(Date)
End If




' 'Save Report Part 3: Check for month folder and create if needed
If Len(Dir("C:\Documents\01 Leidos\01 Admin Ops\01 Daily Operations\01. Reports\04 Contractor PERSTAT" & Year(Date) & MonthNumber(Month(Date) & MonthName(Month(Date), False), vbDirectory))) = 0 Then
MkDir "C:\Documents\01 Leidos\01 Admin Ops\01 Daily Operations\01. Reports\04 Contractor PERSTAT" & Year(Date) & "" & MonthNumber(Month(Date) & MonthName(Month(Date), False))
End If


' 'Save Report Part 4: Save File
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents\01 Leidos\01 Admin Ops\01 Daily Operations\01. Reports\04 Contractor PERSTAT" & Year(Date) & "" & MonthName(Month(Date), False) & "" & "Contractor PERSTAT-" & Format(Now, "dd-mmm-yyyy") & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Function

 

[dmt32]

Hi,
MonthNumber is not a builtin VBA Function hence the error.

If you just want to return the month number then you just need to express following in your code

Month(Date)

Dave

 

[kwooden0626]

Dave,

Thanks for the help. it works perfectly.

 

[mik1996]

thanks for this, ive tried to do this on my code but i need to save its as 2 digits instead i.e 01.January, 02.February, 03.March. but currently when i try this it saves digit (4.April) is there any way to ammend this it would be much appreciated here is my code below:

Sub DateFolderSave_BS1495()
Dim strGenericFilePath      As String: strGenericFilePath = "K:\Finance\Protected Funding Sheets\Money In Funding\BS1495 Funding\"
Dim strYear                 As String: strYear = Year(Date) & "\"
Dim strMonth                As String: strMonth = Month(Date) & "." & MonthName(Month(Date)) & "\"
DateStamp = Format(Date, "dd-mm-yy")
Dim strFileName             As String: strFileName = ("BS1495 Funding" & " " & DateStamp)
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
' Save File
ActiveWorkbook.SaveAs Filename:= _
strGenericFilePath & strYear & strMonth & strDay & strFileName, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Application.DisplayAlerts = True
' Popup Message
MsgBox "File Saved As: " & vbNewLine & strGenericFilePath & strYear & strMonth & strDay & strFileName
End Sub

 

[dmt32]

try

strmonth = Format(Month(Date), "mm")

Dave

 

[mik1996]

try

strmonth = Format(Month(Date), "mm")

Dave

Thanks very much

 

[pscofe]

Hi, wandering if can get some help on this. I've already got the yearly folder saved down and the month as well. Any way this code and can be amended to recognise the current year/month and then saving it in that particular folder? So when I run macro it will just save in April and then when we're in May, it will save in May and so on. Thanks

Sub DateFolderSave_disputes()

Dim strGenericFilePath As String: strGenericFilePath = "N:\PS\MO\COLLt\Investigation\2023"
Dim strYear As String: strYear = Year(Date) & "\"
Dim strMonth As String: strMonth = Month(Date) & "." & MonthName(Month(Date)) & "\"
DateStamp = Format(Date, "dd-mm-yy")
Dim strFileName As String: strFileName = ("Disputes" & " " & DateStamp)
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

' Save File
ActiveWorkbook.SaveAs Filename:= _
strGenericFilePath & strYear & strMonth & strDay & strFileName, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Application.DisplayAlerts = True

' Popup Message
MsgBox "File Saved As: " & vbNewLine & strGenericFilePath & strYear & strMonth & strDay & strFileName

End Sub