Excel VBA运行时错误1004：工作表重命名失败问题排查求助

问题场景 #

执行导入指定文件夹内Excel文件的指定工作表，并将导入后的工作表重命名为「原文件名 - 工作表名」时，触发Runtime Error 1004：您输入了无效的工作表或图表名称，无法定位具体原因。

错误原因 #

Excel对工作表名称有严格规则限制，你的代码直接使用sourceWorkbook.Name（原Excel文件名）拼接名称，大概率触发了以下限制：

• 名称不能包含: / \ ? * [ ]这些非法字符
• 名称长度不能超过31个字符
• 不能以单引号结尾或为空字符串

修复后的代码 #

Sub ImportSheetsFromFolder()
    Dim folderPath As String
    Dim selectedFile As Variant
    Dim targetWorkbook As Workbook
    Dim sourceWorkbook As Workbook
    Dim sheetName As String
    Dim ws As Worksheet
    Dim cleanFileName As String
    
    ' 选择目标文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "选择包含Excel文件的文件夹"
        If .Show = -1 Then
            folderPath = .SelectedItems(1)
        Else
            MsgBox "未选择文件夹，程序退出。"
            Exit Sub
        End If
    End With
    
    ' 设定目标工作簿（当前运行代码的工作簿）
    Set targetWorkbook = ThisWorkbook
    
    ' 输入要导入的工作表名称
    sheetName = InputBox("请输入要导入的工作表名称：", "工作表名称")
    If sheetName = "" Then
        MsgBox "未提供工作表名称，程序退出。"
        Exit Sub
    End If
    
    ' 遍历文件夹内所有xlsx文件
    selectedFile = Dir(folderPath & "\*.xlsx")
    Do While selectedFile <> ""
        ' 打开源工作簿
        Set sourceWorkbook = Workbooks.Open(folderPath & "\" & selectedFile)
        
        ' 检查源工作簿中是否存在目标工作表
        On Error Resume Next
        Set ws = sourceWorkbook.Sheets(sheetName)
        On Error GoTo 0
        
        ' 若工作表存在则导入并重命名
        If Not ws Is Nothing Then
            ws.Copy After:=targetWorkbook.Sheets(targetWorkbook.Sheets.Count)
            ' 清理原文件名中的非法字符
            cleanFileName = CleanSheetName(sourceWorkbook.Name)
            ' 生成合法的新工作表名称并限制长度
            Dim newSheetName As String
            newSheetName = cleanFileName & " - " & sheetName
            ' 确保总长度不超过31字符
            If Len(newSheetName) > 31 Then
                newSheetName = Left(cleanFileName, 31 - Len(" - " & sheetName)) & " - " & sheetName
            End If
            targetWorkbook.Sheets(targetWorkbook.Sheets.Count).Name = newSheetName
        End If
        
        ' 关闭源工作簿不保存更改
        sourceWorkbook.Close False
        
        ' 切换到下一个文件
        selectedFile = Dir
    Loop
    
    MsgBox "导入完成。"
End Sub

' 清理工作表名称的辅助函数
Function CleanSheetName(originalName As String) As String
    Dim invalidChars As Variant
    Dim char As Variant
    invalidChars = Array(":", "/", "\", "?", "*", "[", "]")
    
    ' 替换所有非法字符为空格
    For Each char In invalidChars
        originalName = Replace(originalName, char, " ")
    Next char
    
    ' 去除首尾空格
    originalName = Trim(originalName)
    
    ' 处理空名称情况
    If originalName = "" Then
        originalName = "Sheet"
    End If
    
    CleanSheetName = originalName
End Function

关键修改说明 #

1. 新增CleanSheetName辅助函数：自动过滤/替换Excel工作表名称的非法字符，处理空名称场景
2. 限制最终名称长度：确保拼接后的名称不超过31字符，避免因长度超限触发错误
3. 增强容错性：即使原文件名包含特殊字符，也能生成符合规则的工作表名称

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