VBS调用Excel宏报错：Excel进程残留、PC崩溃问题求助

一、核心问题分析 #

1. 宏代码逻辑错误：关闭CSV工作簿后调用ActiveWorkbook.Save，此时活动对象切换为原xlsm文件，导致原文件被误存到CSV输出路径；替换逻辑不符合需求（原宏实现了0和1互换，而非仅将0替换为1）；大量依赖Select/Activate，非交互模式下易丢失对象引用。
2. VBS脚本缺陷：未显式释放Excel对象，导致进程残留；调用宏后重复保存原工作簿，无必要；Visible设为True不适合非交互场景。
3. 任务计划运行问题：权限不足、未清理残留进程，导致重复运行失败甚至系统崩溃。

二、分步修复方案 #

1. 修复Excel宏代码 #

替换原CopyColumnsToNewSheet宏为以下代码，解决对象引用错误、逻辑错误问题：

Sub CopyColumnsToNewSheet()
    Dim srcWB As Workbook
    Dim srcWS As Worksheet
    Dim destWB As Workbook
    Dim destWS As Worksheet
    Dim copyRange As Range
    
    ' 明确引用源工作簿和工作表，避免依赖Active对象
    Set srcWB = ThisWorkbook
    Set srcWS = srcWB.Worksheets("SMWorkOrder") ' 替换为表所在的实际工作表名
    
    ' 刷新查询表，无需Select
    srcWS.ListObjects("SMWorkOrder").QueryTable.Refresh BackgroundQuery:=False
    
    ' 定义要复制的4列，直接指定范围
    Set copyRange = Union(srcWS.Columns("C"), srcWS.Columns("F"), srcWS.Columns("S"), srcWS.Columns("QI"))
    
    ' 创建新工作簿并粘贴数据
    Set destWB = Workbooks.Add
    Set destWS = destWB.ActiveSheet
    copyRange.Copy destWS.Range("A1")
    
    Application.CutCopyMode = False
    
    ' 执行需求：将目标列（原S列，对应新表C列）的0替换为1
    With destWS.Columns("C")
        .Replace What:="0", Replacement:="1", LookAt:=xlWhole, MatchCase:=False
    End With
    
    ' 删除不需要的列（原QI列，对应新表D列）
    destWS.Columns("D").Delete Shift:=xlToLeft
    
    ' 保存CSV并关闭新工作簿
    Application.DisplayAlerts = False
    destWB.SaveAs Filename:="C:\245942-1\files\CostCodes\CostCodes.csv", FileFormat:=xlCSVUTF8, CreateBackup:=False
    destWB.Close SaveChanges:=False ' 已保存，无需重复保存
    Application.DisplayAlerts = True
    
    ' 标记源工作簿为已保存，避免关闭时弹出提示
    srcWB.Saved = True
End Sub

2. 修复VBS脚本 #

修改TimeClockScript.vbs，解决进程残留、错误捕获问题：

'Input Excel File's Full Path
ExcelFilePath = "C:\245942-1\Excel Run File\smWorkOrders.xlsm"

'Input Module/Macro name within the Excel File
MacroPath = "Module1.CopyColumnsToNewSheet"

'Create an instance of Excel
Set ExcelApp = CreateObject("Excel.Application")

'非交互模式下设置为不可见
ExcelApp.Visible = False

'Prevent any App Launch Alerts (ie Update External Links)
ExcelApp.DisplayAlerts = False

'Open Excel File
Set wb = ExcelApp.Workbooks.Open(ExcelFilePath)

'捕获宏执行错误并记录日志
On Error Resume Next
ExcelApp.Run MacroPath
If Err.Number <> 0 Then
    Dim fso, logFile
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set logFile = fso.OpenTextFile("C:\245942-1\Excel Run File\macro_error.log", 8, True)
    logFile.WriteLine Now() & " - 宏执行错误: " & Err.Description
    logFile.Close
End If
On Error GoTo 0

'Reset Display Alerts Before Closing
ExcelApp.DisplayAlerts = True

'关闭原工作簿，不保存（宏已标记为Saved）
wb.Close SaveChanges:=False

'End instance of Excel
ExcelApp.Quit

'显式释放对象，彻底清除Excel进程
Set wb = Nothing
Set ExcelApp = Nothing

3. 优化批处理与任务计划 #

• 修改批处理：运行前清理残留的Excel进程，避免文件锁定：

@echo off
:: 强制杀死残留的Excel进程
taskkill /f /im excel.exe >nul 2>&1
:: 运行VBS脚本
wscript.exe "C:\245942-1\Excel Run File\TimeClockScript.vbs"

• 任务计划配置：
  • 勾选「不管用户是否登录都要运行」，取消「只有在用户登录时才运行」
  • 勾选「使用最高权限运行」，确保账户有文件访问和SQL连接权限
  • 设置「任务失败时重试」，比如重试3次，每次间隔5分钟

三、长期优化建议 #

完全替换Excel宏方案，改用PowerShell直接读取Azure SQL数据并生成CSV，避免Excel交互带来的稳定性问题：

# 配置Azure SQL连接参数
$serverName = "your-server.database.windows.net"
$databaseName = "your-db-name"
$username = "your-username"
$password = "your-password"
$outputPath = "C:\245942-1\files\CostCodes\CostCodes.csv"

# 构建连接字符串
$connectionString = "Server=tcp:$serverName,1433;Database=$databaseName;User ID=$username;Password=$password;Encrypt=True;TrustServerCertificate=False;Connection Timeout=30;"

# 查询数据并处理0替换为1逻辑
$query = @"
SELECT 
    ColumnC, 
    ColumnF, 
    CASE WHEN ColumnS = '0' THEN '1' ELSE ColumnS END AS ColumnS,
    ColumnQI
FROM SMWorkOrder
"@

# 执行查询并导出为UTF8格式CSV
Invoke-SqlCmd -ConnectionString $connectionString -Query $query | Export-Csv -Path $outputPath -Encoding UTF8 -NoTypeInformation

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