如何修改VBA代码按年月层级目录保存指定格式的xlsm文件？

核心逻辑 #

要实现按年份\月份层级的目录保存，需先提取上一个工作日的年、月信息，拼接成目标路径，同时确保路径不存在时自动创建，避免保存失败。

具体修改步骤 #

• 定义基础变量
  先提取固定根路径，再通过WorkDay函数获取上一个工作日的日期对象，方便后续拆分年、月：

  Dim saveRootPath As String
  Dim targetDate As Date
  saveRootPath = "C:\Users\Sarajevo2022\Company Name\Coworker - OCC ENCORE\"
  targetDate = Application.WorksheetFunction.WorkDay(Date, -2)
  

• 拼接年月层级路径
  用Format函数将日期转换为对应格式的年份（4位数字）和带年份的月份名称（如Dec 2022）：

  Dim yearFolder As String
  Dim monthFolder As String
  Dim fullSavePath As String
  
  yearFolder = Format(targetDate, "yyyy")
  monthFolder = Format(targetDate, "mmm yyyy")
  fullSavePath = saveRootPath & yearFolder & "\" & monthFolder & "\"
  

• 自动创建目录
  用Dir函数判断路径是否存在，不存在则通过MkDir递归创建（注意需先创建年份目录，再创建月份目录）：

  If Dir(fullSavePath, vbDirectory) = "" Then
      If Dir(saveRootPath & yearFolder, vbDirectory) = "" Then
          MkDir saveRootPath & yearFolder
      End If
      MkDir fullSavePath
  End If
  

• 完成保存操作
  拼接路径与文件名，执行保存：

  ActiveWorkbook.SaveAs Filename:=fullSavePath & _
      Format(targetDate, "mmddyyyy") & " ENCORE and Floor", _
      FileFormat:=52 ' 52对应xlsm格式
  

完整代码示例 #

Sub SaveToYearMonthFolder()
    Dim saveRootPath As String
    Dim targetDate As Date
    Dim yearFolder As String
    Dim monthFolder As String
    Dim fullSavePath As String
    
    ' 设置根路径
    saveRootPath = "C:\Users\Sarajevo2022\Company Name\Coworker - OCC ENCORE\"
    ' 获取上一个工作日的日期
    targetDate = Application.WorksheetFunction.WorkDay(Date, -2)
    
    ' 生成年月文件夹名称
    yearFolder = Format(targetDate, "yyyy")
    monthFolder = Format(targetDate, "mmm yyyy")
    fullSavePath = saveRootPath & yearFolder & "\" & monthFolder & "\"
    
    ' 检查并创建目录
    If Dir(fullSavePath, vbDirectory) = "" Then
        ' 先创建年份目录
        If Dir(saveRootPath & yearFolder, vbDirectory) = "" Then
            MkDir saveRootPath & yearFolder
        End If
        ' 再创建月份目录
        MkDir fullSavePath
    End If
    
    ' 保存文件
    ActiveWorkbook.SaveAs Filename:=fullSavePath & _
        Format(targetDate, "mmddyyyy") & " ENCORE and Floor", _
        FileFormat:=52
End Sub

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