基于单元格值保存工作簿至指定文件夹的VBA代码问题

错误根源 #

你的代码核心问题是创建文件夹的路径和保存文件时使用的路径不一致：

• CreateFolder子程序中创建的文件夹路径是：MYPATH & "Audit " & fldNamea & " " & fldNameb（包含"Audit "前缀和两个变量间的空格）
• wbNewFileName子程序中定义的保存路径是：MYPATH & fldNamea & fldNameb & "\"（没有"Audit "前缀，变量间也无空格）

两者路径完全不匹配，自然无法将文件保存到你创建的目标文件夹中。

修正后的代码 #

我们可以将路径生成逻辑提取为一个独立函数，避免重复编写路径字符串导致的错误，同时确保创建文件夹和保存文件使用完全一致的路径：

Option Explicit
'----- 声明基础路径 -----
Const MYPATH As String = "I:\test\"

' 生成目标文件夹路径的函数
Function GetTargetFolderPath() As String
    Dim fldNamea As String
    Dim fldNameb As String
    
    fldNamea = Range("BL5").Value ' 报告编号
    fldNameb = Range("W4").Value ' 报告名称
    
    ' 统一路径格式：基础路径 + Audit 前缀 + 报告编号 + 空格 + 报告名称
    GetTargetFolderPath = MYPATH & "Audit " & fldNamea & " " & fldNameb & "\"
End Function

Sub CreateFolder()
    Dim targetPath As String
    targetPath = GetTargetFolderPath()
    
    ' 检查文件夹是否存在，不存在则创建
    If Len(Dir(targetPath, vbDirectory)) = 0 Then
        MkDir targetPath
    End If
End Sub

Sub wbNewFileName()
    Dim targetPath As String
    Dim newFileName As String
    Dim fldNamea As String
    Dim fldNameb As String
    
    ' 先创建文件夹
    CreateFolder
    
    ' 获取统一的目标路径
    targetPath = GetTargetFolderPath()
    fldNamea = Range("BL5").Value
    fldNameb = Range("W4").Value
    
    ' 生成新文件名
    newFileName = fldNamea & "Report - " & fldNameb & ".xlsm"
    
    ' 保存工作簿到目标文件夹
    ActiveWorkbook.SaveAs _
        Filename:=targetPath & newFileName, _
        FileFormat:=52, _
        CreateBackup:=False

    MsgBox "保存成功"
End Sub

关键修改点 #

• 新增GetTargetFolderPath函数：统一管理路径生成逻辑，避免重复编写导致的不一致
• 确保CreateFolder和wbNewFileName都使用这个函数返回的路径，保证路径完全匹配
• 路径末尾添加\，符合Windows路径格式规范，避免拼接文件名时出错

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