MS Project VBA导出Excel遇运行时错误462：首次正常二次报错

我在MS Project里跑VBA代码，按保存的映射导出Excel表格，接着打开表格做整理和格式设置。第一次运行完全正常，但第二次执行时，代码走到With XLWorksheet块里的Range("C:C").TextToColumns这一行就触发运行时错误462。之前是错误1004，我在代码末尾加了终止所有Excel进程的FindAndTerminate例程后，错误变成了462。要是报错时停掉代码，手动关掉工作簿和Excel，代码又能正常运行。查了些帖子，怀疑是没限定引用导致隐式引用没释放，但自己是新手，没法确认这个猜测。文件存在桌面，没用到SharePoint。

原代码 #

Dim XLApp As Excel.Application
Dim XLwbook As Excel.Workbook
Dim XLWorksheet As Excel.Worksheet
Dim strInputFileName As String

    strInputFileName = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Costs Export " & Format(Date, "ddmmyy") & "_" & Format(Time, "hhnnss") & ".xlsx"
    FileSaveAs Name:="" & strInputFileName & "", FormatID:="MSProject.ACE", Map:="Costs by date"

    Set XLApp = CreateObject("Excel.application")
    Set XLwbook = XLApp.Workbooks.Open(strInputFileName)
    Set XLWorksheet = XLwbook.Worksheets(1)
    
    XLApp.Visible = True

    With XLWorksheet
        'Convert and format export data
        Range("C:C").TextToColumns '<- 第二次运行时此处报错
        Range("D:D").TextToColumns
        Range("E:E").TextToColumns
        Range("F:F").TextToColumns
        Range("G:G").TextToColumns
        Range("C:C").NumberFormat = "dd/mm/yy"
        'Sort
        Range("A1", Range("G1").End(xlDown)).Sort key1:=Range("C1"), order1:=xlAscending, Header:=xlYes
        
        'Add Dev and Tool columns
        Range("D1").EntireColumn.Insert
        Range("D:D").NumberFormat = "#,###"
        Range("D1").Value = "Dev Cost"
        
        'Extract budget or actual figures
        Range("D2", Range("D2").End(xlDown)).Formula = "=IF(H2=999, 0,IF(H2>0, H2, F2))"

        'Insert row and add totals
        Cells(Rows.Count, "A").End(xlUp).EntireRow.Delete
        Range("A1").EntireRow.Insert
        Range("D1").Value = WorksheetFunction.Sum(.Range("D:D"))

        Columns("A:I").AutoFit
    End With

    XLwbook.Close (True)
    Set XLWorksheet = Nothing
    Set XLwbook = Nothing
    
    XLApp.Quit
    Set XLApp = Nothing

'Kill all Excel processes
FindAndTerminate

End Sub

解决方法 #

核心问题 #

With XLWorksheet代码块里的Range、Cells、Columns都没加前缀.，属于未限定引用——这些对象会默认绑定到当前激活的Excel实例，一旦前一次运行的Excel进程没彻底释放，就会出现引用混乱，触发错误。

具体修正步骤 #

1. 限定所有工作表对象引用：在With XLWorksheet块内，所有Range、Cells、Columns前面都加上.，确保引用的是指定的XLWorksheet，而不是全局默认对象。
2. 移除暴力杀进程的代码：正常释放对象后不需要强制终止Excel进程，FindAndTerminate反而可能破坏对象释放逻辑，导致残留引用。
3. 明确TextToColumns参数：原代码没指定分隔符，可能导致意外格式问题，建议根据导出数据的实际分隔类型明确参数（比如逗号分隔就加Comma:=True）。
4. 修正排序范围的引用：排序时的单元格范围也要用.限定，避免引用错误。

修正后的代码 #

Dim XLApp As Excel.Application
Dim XLwbook As Excel.Workbook
Dim XLWorksheet As Excel.Worksheet
Dim strInputFileName As String

    strInputFileName = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Costs Export " & Format(Date, "ddmmyy") & "_" & Format(Time, "hhnnss") & ".xlsx"
    FileSaveAs Name:=strInputFileName, FormatID:="MSProject.ACE", Map:="Costs by date"

    Set XLApp = CreateObject("Excel.application")
    Set XLwbook = XLApp.Workbooks.Open(strInputFileName)
    Set XLWorksheet = XLwbook.Worksheets(1)
    
    XLApp.Visible = True

    With XLWorksheet
        'Convert and format export data - 明确TextToColumns参数，这里假设是逗号分隔，可根据实际调整
        .Range("C:C").TextToColumns Destination:=.Range("C1"), DataType:=xlDelimited, Comma:=True
        .Range("D:D").TextToColumns Destination:=.Range("D1"), DataType:=xlDelimited, Comma:=True
        .Range("E:E").TextToColumns Destination:=.Range("E1"), DataType:=xlDelimited, Comma:=True
        .Range("F:F").TextToColumns Destination:=.Range("F1"), DataType:=xlDelimited, Comma:=True
        .Range("G:G").TextToColumns Destination:=.Range("G1"), DataType:=xlDelimited, Comma:=True
        .Range("C:C").NumberFormat = "dd/mm/yy"
        
        'Sort - 限定所有Range引用
        .Range("A1", .Range("G1").End(xlDown)).Sort key1:=.Range("C1"), order1:=xlAscending, Header:=xlYes
        
        'Add Dev and Tool columns
        .Range("D1").EntireColumn.Insert
        .Range("D:D").NumberFormat = "#,###"
        .Range("D1").Value = "Dev Cost"
        
        'Extract budget or actual figures
        .Range("D2", .Range("D2").End(xlDown)).Formula = "=IF(H2=999, 0,IF(H2>0, H2, F2))"

        'Insert row and add totals
        .Cells(.Rows.Count, "A").End(xlUp).EntireRow.Delete
        .Range("A1").EntireRow.Insert
        .Range("D1").Value = WorksheetFunction.Sum(.Range("D:D"))

        .Columns("A:I").AutoFit
    End With

    XLwbook.Close (True)
    Set XLWorksheet = Nothing
    Set XLwbook = Nothing
    
    XLApp.Quit
    Set XLApp = Nothing

End Sub

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