VBA to Save Worksheet With Current Date (Opening New Folder For Month / Year)

[Small Paul]

Hi All
I have a number of worksheets produced each day which need saving.
The worksheet name is formatted as "yyyy mm dd"

I need it saved in the relevant month's folder and, if not available, set that folder up. The month folder is set as, for example, "08 August" and "09 September". This way, they sit in order within the year folder.

Ideally, the VBA would also set up a year folder when required.

Looking through other posts, the best I can find is:

    Dim fPath As String    MkDir "Z:\Orders\2-Open Trades" & Format(Date, "yyyy") & "" & Format(Date, "mm-yy")
    fPath = "Z:\Orders\2-Open Trades" & Format(Date, "yyyy") & "" & Format(Date, "mm-yy")

which doesn't actually save the file at all!

The directory for the main file is:

Z:\Orders\2-Open Trades\yyyy\[08 August] see above\filename.xls

I can then adjust (primary folders) accordingly.

Any assistance would be appreciated.

Many thanks
Small Paul.

 

[JumboCactuar]

ah because its not the default drive you need to set it (chdrive)

try:

Sub dfhh()
Dim strDir As String, DflDir As String, YrDir As String, WB1 As Workbook
    DflDir = "Z:\Orders\2-Open Trades\"
    YrDir = (DflDir & Format(Date, "yyyy"))
    strDir = (YrDir & "\" & Format(Date, "mm") & " " & Format(Date, "mmmm"))
    Set WB1 = ThisWorkbook
    
    If Dir(DflDir, vbDirectory) = "" Then MkDir DflDir
    If Dir(YrDir, vbDirectory) = "" Then MkDir YrDir
    If Dir(strDir, vbDirectory) = "" Then MkDir strDir
    ChDrive strDir
    ChDir strDir
    Filename = Format(Now, "yyyy-mm-dd")
    WB1.SaveCopyAs Filename:=Filename & ".xlsm"
    
End Sub

 

[Small Paul]

It makes sense to my tiny brain but still does not save!
I have put as:

    With Range("H2:K500")        .HorizontalAlignment = xlCenter
    End With
    Range("A1").Select
Dim strDir As String, DflDir As String, YrDir As String, WB1 As Workbook
    DflDir = "Z:\Orders\2-Open Trades\"
    YrDir = (DflDir & Format(Date, "yyyy"))
    strDir = (YrDir & "\" & Format(Date, "mm") & " " & Format(Date, "mmmm"))
    Set WB1 = ThisWorkbook
    
    If Dir(DflDir, vbDirectory) = "" Then MkDir DflDir
    If Dir(YrDir, vbDirectory) = "" Then MkDir YrDir
    If Dir(strDir, vbDirectory) = "" Then MkDir strDir
    ChDrive strDir
    ChDir strDir
    Filename = Format(Now, "yyyy-mm-dd")
    WB1.SaveCopyAs Filename:=Filename & ".xlsm"
    
End Sub