如何使用VBA将Excel生成的发票按月份自动保存到对应文件夹

核心改动说明 #

要实现按发票日期的英文月份文件夹保存，需要新增日期解析、月份文件夹创建、路径拼接这几个关键逻辑，同时修正原代码里的格式匹配问题：

• 从指定单元格提取发票日期，转成January这类完整英文月份名
• 自动检查对应月份文件夹是否存在，不存在则创建
• 修正保存文件的后缀与格式匹配（宏启用工作簿对应.xlsm而非.xls）
• 增加基础错误处理，避免无效日期导致程序崩溃

完善后的完整代码 #

Sub SaveInvoice()
    Dim path As String
    Dim MyFile As String
    Dim invoiceDate As Date
    Dim monthFolder As String
    Dim fso As Object
    
    ' 初始化文件系统对象，用于文件夹操作
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 基础路径
    path = "\\Japan\admin\Planning & Costing\Finance\Billing\DATA BILLING\IMPORT\2023\"
    
    On Error GoTo ErrorHandler ' 错误捕获
    
    ' 提取发票日期（假设日期存放在J13单元格，可根据实际修改）
    invoiceDate = Range("J13").Value
    ' 转换为英文月份文件夹名（如January）
    monthFolder = Format(invoiceDate, "mmmm")
    
    ' 拼接带月份文件夹的完整路径
    path = path & monthFolder & "\"
    
    ' 如果月份文件夹不存在，创建它
    If Not fso.FolderExists(path) Then
        fso.CreateFolder path
    End If
    
    ' 生成文件名（保留原逻辑，日期转标准文本避免乱码）
    MyFile = Range("C13") & "_" & Range("H11") & "_" & Format(invoiceDate, "yyyy-mm-dd")
    
    ' 保存为宏启用工作簿（后缀与格式匹配）
    ActiveWorkbook.SaveAs Filename:=path & MyFile & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
    
    Application.DisplayAlerts = True
    MsgBox "保存完成！谢谢~"
    
    ' 清理对象
    Set fso = Nothing
    Exit Sub
    
ErrorHandler:
    MsgBox "保存失败：" & Err.Description & vbCrLf & "请检查发票日期是否有效", vbExclamation
    Set fso = Nothing
End Sub

关键细节说明 #

• 日期单元格：代码里假设发票日期在J13，如果你的日期存放在其他单元格，修改Range("J13")即可
• 月份文件夹命名：Format(invoiceDate, "mmmm")会生成完整英文月份名，若要缩写（如Jan）可改成Format(invoiceDate, "mmm")
• 文件名里的日期：把原代码里的Range("J13").Text改成标准格式文本，避免因系统日期格式不同导致文件名出现特殊字符
• 文件夹创建：用FileSystemObject比原生MkDir更稳妥，支持跨层级创建文件夹（如果基础路径下有缺失的父级文件夹也能自动创建）

内容的提问来源于stack exchange，提问作者kimk