VBA创建保存工作簿遇问题：XLS打开报错、XLSX保存失败

以下是我编写的批量创建并保存工作簿的VBA宏：

Sub CreateSheets()
Dim PathName As String
Dim strName As String
Dim FromNum As Integer
Dim ToNum As Integer
Dim a_counter As Integer

On Error GoTo Err

FromNum = Application.InputBox("Enter Start number")
ToNum = Application.InputBox("Enter End number")
'PathName = "\Albaserver2\my documents\ALBA REPORTS NOV 2017\"

PathName = "U:\ALBA REPORTS NOV 2017\"
'PathName = "I:\Alba Work\"
'Application.DisplayAlerts = False 'IT WORKS TO DISABLE ALERT PROMPT

For a_counter = FromNum To ToNum

    ActiveWorkbook.Sheets(1).Range("F3") = a_counter
    strName = Sheet1.Range("F3").Value
    strName = CStr(a_counter)

    ActiveWorkbook.SaveCopyAs Filename:=PathName & strName & ".xls" ', FileFormat:= _
      xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
      , CreateBackup:=False

    'Application.DisplayAlerts = True

Next a_counter
ActiveWorkbook.Close

Exit Sub

Err:
    MsgBox Err.Description
End Sub

目前遇到以下问题：

• 生成的XLS格式工作簿打开时弹出错误提示，点击「是」后可正常打开；
• 尝试将保存格式改为.XLSX时，保存操作失败；
• 改用FileFormat:=52保存启用宏的工作簿仍存在问题，特此求助。

问题分析与解决办法 #

1. XLS格式打开报错的原因与解决 #

用SaveCopyAs保存为.xls时，原工作簿大概率是高版本格式（比如.xlsm），直接复制副本会导致格式不兼容，触发打开错误。解决办法：放弃SaveCopyAs，改用SaveAs方法并指定旧版XLS的格式代码xlExcel8，同时临时关闭系统警报避免弹窗。

2. 保存为XLSX失败的原因与解决 #

XLSX是无宏格式，如果原工作簿包含VBA代码，直接保存为XLSX会失败（无宏容器不允许存储宏）：

• 若无需保留宏：先移除原工作簿的宏代码，再用SaveAs指定FileFormat:=xlOpenXMLWorkbook保存为XLSX；
• 若需保留宏：必须保存为XLSM格式（对应FileFormat:=xlOpenXMLWorkbookMacroEnabled）。

3. 用FileFormat:=52保存的问题解决 #

FileFormat:=52对应启用宏的XLSM格式，但SaveCopyAs方法不支持指定FileFormat参数，必须改用SaveAs才能生效。

修改后的完整代码 #

Sub CreateSheets()
    Dim PathName As String
    Dim strName As String
    Dim FromNum As Integer
    Dim ToNum As Integer
    Dim a_counter As Integer
    Dim originalWB As Workbook
    
    On Error GoTo ErrHandler
    
    '固定原工作簿对象，避免ActiveWorkbook意外切换
    Set originalWB = ActiveWorkbook
    '限制输入为整数，避免类型错误
    FromNum = Application.InputBox("输入起始编号", Type:=1)
    ToNum = Application.InputBox("输入结束编号", Type:=1)
    
    PathName = "U:\ALBA REPORTS NOV 2017\"
    '确保路径末尾有斜杠，避免文件名拼接错误
    If Right(PathName, 1) <> "\" Then PathName = PathName & "\"
    
    '关闭保存时的系统警报，跳过格式转换提示弹窗
    Application.DisplayAlerts = False
    
    For a_counter = FromNum To ToNum
        originalWB.Sheets(1).Range("F3") = a_counter
        strName = CStr(a_counter)
        
        '===== 按需选择以下一种保存格式 =====
        '1. 保存为启用宏的XLSM格式（推荐，保留宏）
        originalWB.SaveAs Filename:=PathName & strName & ".xlsm", _
            FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
            Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
            
        '2. 保存为无宏的XLSX格式（需确保原工作簿无宏）
        'originalWB.SaveAs Filename:=PathName & strName & ".xlsx", _
        '    FileFormat:=xlOpenXMLWorkbook, _
        '    Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
            
        '3. 保存为旧版XLS格式（兼容低版本Excel）
        'originalWB.SaveAs Filename:=PathName & strName & ".xls", _
        '    FileFormat:=xlExcel8, _
        '    Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    Next a_counter
    
    '恢复系统警报
    Application.DisplayAlerts = True
    '关闭原工作簿，不保存修改
    originalWB.Close SaveChanges:=False
    
    Exit Sub
    
ErrHandler:
    MsgBox "错误信息：" & Err.Description, vbExclamation
    '确保即使出错也恢复警报设置
    Application.DisplayAlerts = True
End Sub

代码修改说明 #

• 新增originalWB变量固定原工作簿，避免ActiveWorkbook切换导致异常；
• 给InputBox增加Type:=1限制输入为整数，防止非数字输入错误；
• 自动修正路径末尾斜杠，避免文件名拼接错误；
• 临时关闭系统警报，跳过格式转换确认弹窗；
• 分三种格式给出保存代码，按需注释/取消注释使用。

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