如何使用VBA保存Excel中创建的发票

idfiyjo8  于 2023-01-18  发布在  其他
关注(0)|答案(1)|浏览(276)

保存发票,自动进入文件夹根据月份。这意味着,如果发票日期在2023年1月15日,所以当它保存将进入一月文件夹,而不是其他月份,如五月六月等。

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
a0x5cqrl

a0x5cqrl1#

按年和月将文件保存在子文件夹中

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

相关问题