VBA执行MkDir触发Run-time error 76，求解决方案

我在多个工作簿中使用以下SaveAsA1宏代码，但在新工作簿项目中运行时总是触发Run-time error 76（路径未找到）。代码预期在指定文件夹不存在时创建新文件夹，移除MkDir代码后可正常运行，但缺少了文件夹存在性判断逻辑。

原代码如下：

Public Sub SaveAsA1()
Range("C9").Value = Application.UserName

Set rRng = Sheet1.Range("C8")
    If IsEmpty(rRng.Value) Then

        MsgBox ("Cell (C8) is empty. Please scan in the correct work order number into (C8)")
        End
    Else
    End If

Dim Result As Integer
Result = MsgBox("Are you sure you want to save?", vbQuestion + vbYesNo)
If Result = vbYes Then
MsgBox "\\us.\TEST_DATA\MODULE\" & "WO_" & Range("C8")
Else
End
End If
 
'Variable declaration
    Dim sFolderPath As String
    Dim oFSO As Object
    
    'Define Folder Path
    sFolderPath = "Now saving to \\us.\TEST_DATA\MODULE\" & "WO_" & Range("C8")
    
    'Create FSO Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    
    'Check Specified Folder exists or not
    If oFSO.FolderExists(sFolderPath) Then
        'If Folder is available
    Else
    
    'If folder is not available
    MkDir sFolderPath '<-------------Run time error 76
     End If
End Sub

问题根源 #

你的sFolderPath变量里错误地包含了前缀文本"Now saving to "，导致MkDir尝试创建一个包含该文本的无效路径，系统无法识别这个路径，因此触发路径未找到错误。同时，MsgBox显示的路径和实际要创建的路径不一致，容易造成混淆。

修正后的代码 #

Option Explicit '强制变量声明，减少潜在错误
Public Sub SaveAsA1()
    Dim rRng As Range
    Dim Result As Integer
    Dim sFolderPath As String
    Dim oFSO As Object
    
    '填充当前用户名到C9
    Sheet1.Range("C9").Value = Application.UserName
    
    '检查C8是否为空
    Set rRng = Sheet1.Range("C8")
    If IsEmpty(rRng.Value) Then
        MsgBox "单元格(C8)为空，请扫描正确的工单编号到(C8)"
        Exit Sub '用Exit Sub替代End，更安全
    End If
    
    '确认保存操作
    Result = MsgBox("确定要保存吗？", vbQuestion + vbYesNo)
    If Result <> vbYes Then
        Exit Sub
    End If
    
    '定义正确的文件夹路径
    sFolderPath = "\\us.\TEST_DATA\MODULE\WO_" & rRng.Value
    '提示当前保存路径
    MsgBox "正在保存到：" & sFolderPath
    
    '创建FSO对象
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    
    '检查文件夹是否存在，不存在则创建
    If Not oFSO.FolderExists(sFolderPath) Then
        oFSO.CreateFolder sFolderPath '用FSO的CreateFolder替代MkDir，支持多级目录创建
    End If
    
    '这里可以添加后续的保存工作簿代码，比如：
    'ThisWorkbook.SaveAs sFolderPath & "\你的文件名.xlsx"
End Sub

关键修正点 #

1. 移除sFolderPath中的无效前缀文本，确保路径为纯网络路径
2. 用oFSO.CreateFolder替代MkDir：它支持创建多级目录（如果父目录不存在也能自动创建），比MkDir更健壮
3. 统一路径变量，让MsgBox显示的路径和实际创建的路径一致
4. 添加Option Explicit强制变量声明，避免未声明变量导致的错误
5. 用Exit Sub替代End，让宏更优雅地退出，避免强制中断程序

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