How to save invoice created in excel using VBA-CodePudding

Save invoice that automate into folder according to month. Means that if the invoice date on 15 January 2023 so when it save will go to January folder not the other month such as May June etc.

Sub SaveInvoice()
Dim path As String
Dim MyFile As String path = "\\Japan\admin\Planning & Costing\Finance\Billing\DATA BILLING\IMPORT\2023\"
MyFile = Range("C13") & "_" & Range("H11") & "_" & Range("J13").Text 

'create invoice in XLSX format
ActiveWorkbook.SaveAs Filename:=path & MyFile & ".xls", FileFormat:=xlOpenXMLWorkbookMacroEnabled 

'ActiveWorkbook.Close
Application.DisplayAlerts = True 
MsgBox "Saving Complete! Thank you~" 
End Sub

CodePudding user response：

Save File in Subfolders By Year and By Month

Sub SaveInvoice()
    
    Const DST_INITIAL_PATH As String = "\\Japan\admin\" _
        & "Planning & Costing\Finance\Billing\DATA BILLING\IMPORT\"
    
    If Len(Dir(DST_INITIAL_PATH, vbDirectory)) = 0 Then
        MsgBox "The initial path """ & DST_INITIAL_PATH & """doesn't exist.", _
            vbCritical
        Exit Sub
    End If
    
    Dim iDate As Date: iDate = Date ' today
    
    Dim dPath As String: dPath = DST_INITIAL_PATH & Format(iDate, "yyyy") & "\"
    If Len(Dir(dPath, vbDirectory)) = 0 Then MkDir dPath
    
    dPath = dPath & Format(iDate, "mmmm") & "\"
    If Len(Dir(dPath, vbDirectory)) = 0 Then MkDir dPath

    Dim dws As Worksheet: Set dws = ActiveSheet ' improve!

    Dim dFileName As String: dFileName = dws.Range("C13").Text _
        & dws.Range("H11").Text & dws.Range("J13").Text & ".xlsx"
    
    With dws.Parent
        Application.DisplayAlerts = False ' to overwrite without confirmation
            .SaveAs Filename:=dPath & dFileName, FileFormat:=xlOpenXMLWorkbook
        Application.DisplayAlerts = True
        .Close SaveChanges:=False
    End With
    
    MsgBox "Saving Complete! Thank you.", vbInformation

End Sub