You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

Excel VBA Refresh宏运行报错，请求故障排查与修复支持

avatar
数据老陈
2026-8-3
Excel VBA运行时错误'1004'排查与修复

运行Excel中的Refresh宏时触发运行时错误'1004'（应用程序定义或对象定义错误），宏代码及错误截图如下：

Sub Refresh()
'
' Refresh Macro
'
    'Save a copy with date stamp before refreshing data
    Dim dtToday As String
    dtToday = Format(Date, "yyyymmdd")
    ActiveWorkbook.SaveCopyAs Filename:="\\NABDC01SDPRS01\C01905_SHARE_S_01\TOR1\Resource\Service Ontario RESP Tracker\Archived\RESP Leads List_" & dtToday & ".xlsm"
'
    Dim reccnt As Integer
    ActiveWorkbook.Connections("Query - service_ontario_master_list").Refresh
    
    'Added logic in hope that it will wait for connectino to refresh before running the rest of code
    ActiveWorkbook.Save

    Sheets("Working List").Select
    'Unprotect sheet
    ActiveSheet.Unprotect
    
    'Added logic to remove all filter before delete.  This should resolve the duplicate issue
    ActiveWorkbook.Worksheets("Working List").ListObjects("Table2").AutoFilter.ShowAllData
    
    Cells.Select
    Selection.EntireColumn.Hidden = False
    reccnt = Range("A3") + 1
    Range("A5:AO1000").Select
    Selection.clear
    Sheets("Query").Select
    Range(Cells(2, 1), Cells(reccnt, 40)).Select
    Selection.Copy
    Sheets("Working List").Select
    Range("A5").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("S3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("S5").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    
   
    Range(Cells(5, 22), Cells(5 + reccnt, 22)).Select
    Application.CutCopyMode = False
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Lists!$D$3:$D$6"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    Range(Cells(5, 29), Cells(5 + reccnt, 29)).Select
    Application.CutCopyMode = False
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Lists!$D$3:$D$6"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    Range(Cells(5, 35), Cells(5 + reccnt, 35)).Select
    Application.CutCopyMode = False
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Lists!$D$3:$D$6"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    Range("AA5").Select
    Application.CutCopyMode = False
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Lists!$B$3:$B$12"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    Range(Cells(5, 27), Cells(5 + reccnt, 27)).Select
    Application.CutCopyMode = False
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Lists!$B$3:$B$12"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    Range(Cells(5, 33), Cells(5 + reccnt, 33)).Select
    Application.CutCopyMode = False
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Lists!$B$3:$B$12"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    Range(Cells(5, 39), Cells(5 + reccnt, 39)).Select
    Application.CutCopyMode = False
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Lists!$B$3:$B$12"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    Range(Cells(5, 3), Cells(5 + reccnt, 3)).Select
    Application.CutCopyMode = False
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Lists!$K$3:$K$4"
        .IgnoreBlank = False
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    
    'Add data validation (drop down) for Status and Outcome
    Range("T5").Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Lists!$N$3:$N$4"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    Range("U5").Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Lists!$B$3:$B$5"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    
    'Sort list: lead arrival data aesc and UID aesc
    ActiveWorkbook.Worksheets("Working List").ListObjects("Table2").sort.SortFields _
        .clear
    ActiveWorkbook.Worksheets("Working List").ListObjects("Table2").sort.SortFields _
        .Add2 Key:=Range("Table2[Lead Arrival Date]"), SortOn:=xlSortOnValues, _
        Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Working List").ListObjects("Table2").sort.SortFields _
        .Add2 Key:=Range("Table2[UID]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Working List").ListObjects("Table2").sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    'Hide calculation columns
    Range("A:B").EntireColumn.Hidden = True
    Columns("F:G").Select
    Selection.EntireColumn.Hidden = True
    Range("Y:Y").EntireColumn.Hidden = True
    'Freeze Panel
    Range("H5").Select
    ActiveWindow.FreezePanes = True
    
    'Protect Sheet
    Columns("T:AN").Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    Range("V1:AN4").Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    Columns("C:C").Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    Range("C1:C4").Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    Columns("D:U").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True
    
    'Date Cloumns Adjustment
    Columns("W:W").ColumnWidth = 13
    Columns("W:W").NumberFormat = "m/d/yyyy"
    Columns("AD:AD").ColumnWidth = 13
    Columns("AD:AD").NumberFormat = "m/d/yyyy"
    Columns("AJ:AJ").ColumnWidth = 13
    Columns("AJ:AJ").NumberFormat = "m/d/yyyy"
    
    Range("V4").Select
    
End Sub

运行时错误'1004'：应用程序定义或对象定义错误

常见触发原因及修复方案

  • 查询刷新未完成就执行后续代码
    原代码用ActiveWorkbook.Save无法保证查询刷新完成，改为强制同步等待：

    '替换原查询刷新代码
With ActiveWorkbook.Connections("Query - service_ontario_master_list").OLEDBConnection
    .BackgroundQuery = False '关闭后台查询，等待数据加载完成
    .Refresh
End With

  • 未明确指定工作表，依赖激活状态出错
    原代码大量使用Select和ActiveSheet，容易因当前激活表变化触发错误，改为直接指定工作表对象：
    例如把Range("A3")改为Sheets("Working List").Range("A3")，把ListObjects("Table2")改为Sheets("Working List").ListObjects("Table2")。

  • 数据验证范围计算错误
    原代码中reccnt取值依赖A3单元格，若A3非数字会直接报错，同时5+reccnt可能超出实际数据范围：

    '先验证A3是否为数字
If IsNumeric(Sheets("Working List").Range("A3").Value) Then
    reccnt = Sheets("Working List").Range("A3").Value + 1
Else
    MsgBox "A3单元格必须为数字"
    Exit Sub
End If
'用实际数据最后一行替代固定计算值
Dim lastRow As Long
lastRow = Sheets("Working List").Cells(Rows.Count, "A").End(xlUp).Row
'示例：修改数据验证范围
With Sheets("Working List").Range(Cells(5,22), Cells(lastRow,22)).Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=Lists!$D$3:$D$6"
    .IgnoreBlank = True
    .InCellDropdown = True
End With

  • 工作表保护/解锁逻辑冲突
    若工作表有保护密码，需补充密码参数；同时避免重复选择单元格，直接批量设置锁定状态：

    '解锁工作表（有密码则补充）
Sheets("Working List").Unprotect Password:="你的密码"
'批量设置锁定状态
With Sheets("Working List")
    .Columns("T:AN").Locked = False
    .Range("V1:AN4").Locked = True
    .Columns("C:C").Locked = False
    .Range("C1:C4").Locked = True
    .Columns("D:U").Locked = True
    '执行保护
    .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True
End With

  • 保存副本时路径权限/存在性问题
    检查网络路径的访问权限，添加错误捕获避免因保存失败中断流程：

    On Error Resume Next
ActiveWorkbook.SaveCopyAs Filename:="\\NABDC01SDPRS01\C01905_SHARE_S_01\TOR1\Resource\Service Ontario RESP Tracker\Archived\RESP Leads List_" & dtToday & ".xlsm"
If Err.Number <> 0 Then
    MsgBox "保存副本失败：" & Err.Description
    Err.Clear
    Exit Sub
End If
On Error GoTo 0

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

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级，最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分)， 限时 9.9 元起

产品介绍相关文档
相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级，最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分)， 限时 9.9 元起

产品介绍相关文档
火山引擎 最新活动
全面开放
Doubao-Seedance-2.5全新模型升级

模型再升级,30秒超长叙事, 模态参考扩容

HOT
方舟Codingplan

模型自由，工具不限，最新支持 Deepseek-V4 系列、GLM-5.3 系列

HOT
方舟Agent plan

超全模态模型 × Harness 升级，最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列

HOT
新用户特惠专场

大模型19元起，Al应用9.9元畅享，新人首购爆款尽享优惠

最近更新时间：2026.08.03 05:01:10