VBA脚本保存Excel文件时文件名与存储路径异常问题排查

现象总结 #

• 处理2023版旧文件时，首次SaveAs生成文件名2023 GAB Database 2023.xlsx，未保存到指定的[..]\118 (UPD WEKELIJKS) Update\2023目录，而是保存至上级目录[..]\118 (UPD WEKELIJKS) Update\；第二次SaveAs生成的GAB Database 2023.xlsx保存正常。
• 2024版文件无此问题，用户对目标目录有读写权限，文件未被占用，目标目录只读属性不影响手动读写。

相关VBA代码 #

Sub replace()

[some declarations]

'确定打开的xlsm文件的路径和文件名
wbfilepath0 = ThisWorkbook.Path
wbFilepath1 = "I:\KMAR\LTC\SPT\IV&CIS\IV PLANS\BICC_BVI_IMPORT\03_TCB\"
wbFilename0 = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5)

'关闭可能已打开的GAB Database .xlsx文件，不保存更改
myWB = wbFilename0 & ".xlsx"

For Each WB In Workbooks
    If WB.Name = myWB Then
        WB.Close SaveChanges:=False
    End If
Next WB

[some lines of code]
wbfilepath0 = ThisWorkbook.Path
wbFilepath1 = "I:\KMAR\LTC\SPT\IV&CIS\IV PLANS\BICC_BVI_IMPORT\03_TCB\"
wbFilename0 = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5)

'将2个需要的工作表复制到新文件
ThisWorkbook.Sheets(Array("Hoofdbestand", "Database")).Copy

Application.DisplayAlerts = False

'以下将新文件保存到两个不同位置，保存为.XLSX格式，且确保文件未被打开（已在程序开头检查）
With ActiveWorkbook
    .SaveAs Filename:=wbfilepath0 & wbFilename0 & ".xlsx", FileFormat:=51
    .SaveAs Filename:=wbFilepath1 & wbFilename0 & ".xlsx", FileFormat:=51
    .Close
End With

[some other lines of code]

End Sub

注：wbFilename0对应GAB Database 2023.xlsm去掉.xlsm后缀后的文件名部分（即GAB Database 2023）

代码层面的异常原因 #

1. 路径拼接缺少分隔符 #

代码中首次SaveAs的路径直接拼接wbfilepath0 & wbFilename0 & ".xlsx"，未确保wbfilepath0（即ThisWorkbook.Path）末尾带有反斜杠\：

• 若ThisWorkbook.Path返回的路径末尾无反斜杠（例如[..]\118 (UPD WEKELIJKS) Update\2023），路径与文件名会直接粘连，系统可能将路径的最后一段（如2023）识别为文件名的前缀，导致最终文件名异常，甚至因路径不合法自动保存到上级目录。
• 2024版文件无此问题，大概率是因为其所在路径末尾自带反斜杠，或路径本身格式规范。

2. 文件名提取逻辑依赖固定长度 #

代码用Left(ThisWorkbook.Name, Len(ThisWorkbook.Name)-5)提取文件名，依赖.xlsm后缀固定为5个字符（.+xlsm）。如果旧文件的实际文件名是2023 GAB Database 2023.xlsm（而非预期的GAB Database 2023.xlsm），提取后会得到2023 GAB Database 2023，保存后自然生成异常文件名。

3. 路径依赖当前工作簿位置 #

首次SaveAs依赖ThisWorkbook.Path作为保存路径，如果旧文件实际所在的路径并非预期的[..]\118 (UPD WEKELIJKS) Update\2023，而是上级目录，自然会保存到错误位置。

修复建议 #

• 规范路径拼接：手动判断并添加反斜杠，避免路径与文件名粘连：

  If Right(wbfilepath0, 1) <> "\" Then
      wbfilepath0 = wbfilepath0 & "\"
  End If
  

• 验证文件名取值：添加调试语句确认ThisWorkbook.Name和wbFilename0的实际值，排查文件名格式问题：

  Debug.Print "当前工作簿名称：" & ThisWorkbook.Name
  Debug.Print "提取的文件名：" & wbFilename0
  

• 明确指定目标路径：如果首次保存的目标是固定的[..]\118 (UPD WEKELIJKS) Update\2023，直接硬编码该路径，不要依赖ThisWorkbook.Path。

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