如何让导出工作表的VBA宏稳定运行？解决Runtime Error 1004问题

原代码的核心问题 #

• 硬编码路径错误："C:FilePath"格式不合法，且未使用定义好的FPath变量，导致路径无效
• 依赖ActiveWorkbook和Select方法：这类操作容易因窗口焦点变化触发错误，稳定性差
• 缺乏错误处理机制：单个工作表导出失败会直接中断整个流程，无法定位问题
• 未处理文件名非法字符：工作表名若包含/ \ : * ? " < > |等字符，会导致保存失败
• 未检查工作簿是否已保存：当原工作簿未保存时，ActiveWorkbook.Path为空，路径拼接出错

修改后的稳定版代码 #

Sub ExportSU400_XLSX()
    Dim FPath As String
    Dim xWs As Worksheet
    Dim ArraySheet As Sheets
    Dim newWB As Workbook
    Dim fileName As String
    
    ' 获取选中的工作表集合
    Set ArraySheet = ActiveWindow.SelectedSheets
    
    ' 检查原工作簿是否已保存，避免路径为空
    If Application.ActiveWorkbook.Path = "" Then
        MsgBox "请先保存当前工作簿，再执行导出操作！", vbExclamation
        Exit Sub
    End If
    
    FPath = Application.ActiveWorkbook.Path
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    For Each xWs In ArraySheet
        ' 跳过图表工作表（如果有的话），避免复制出错
        If xWs.Type = xlWorksheet Then
            ' 直接复制工作表到新工作簿，并获取新工作簿对象
            xWs.Copy
            Set newWB = Application.ActiveWorkbook
            
            ' 处理文件名中的非法字符
            fileName = "File Name " & xWs.Name & Format(Now(), "_yyyy.mm.dd") & ".xlsx"
            fileName = Replace(fileName, "/", "-")
            fileName = Replace(fileName, "\", "-")
            fileName = Replace(fileName, ":", "-")
            fileName = Replace(fileName, "*", "-")
            fileName = Replace(fileName, "?", "-")
            fileName = Replace(fileName, """", "-")
            fileName = Replace(fileName, "<", "-")
            fileName = Replace(fileName, ">", "-")
            fileName = Replace(fileName, "|", "-")
            
            ' 使用FPath变量拼接路径，避免硬编码错误
            On Error Resume Next ' 启用错误捕获
            newWB.SaveAs Filename:=FPath & "\" & fileName, FileFormat:=xlOpenXMLWorkbook ' 用常量代替数值51，可读性更强
            If Err.Number <> 0 Then
                MsgBox "导出工作表 " & xWs.Name & " 失败：" & Err.Description, vbCritical
                Err.Clear
            End If
            On Error GoTo 0 ' 关闭错误捕获
            
            newWB.Close SaveChanges:=False
            Set newWB = Nothing ' 释放对象
        End If
    Next xWs
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "导出操作完成！", vbInformation
End Sub

关键改进点说明 #

• 避免依赖活动对象：直接将复制后的新工作簿赋值给newWB变量，不再用ActiveWorkbook，彻底消除焦点变化带来的错误
• 修复路径问题：使用原工作簿的路径变量FPath，并先检查工作簿是否已保存，防止路径为空
• 处理非法文件名：替换工作表名中所有Windows不允许的字符，避免因文件名非法导致的1004错误
• 添加错误处理：捕获单个工作表导出的错误，记录失败原因，且不中断整个宏的执行
• 使用常量代替数值：用xlOpenXMLWorkbook代替51，代码可读性更强，且不易出错
• 跳过非工作表对象：判断工作表类型，避免复制图表等非工作表对象时出错

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