VBA网页数据查询触发1004应用定义/对象定义错误求助

安全阿岳

2026-7-28

问题描述

尝试使用VBA查询网站数据时，执行查询出现1004错误（Application-defined or object-defined error），目标网站地址：https://www.troa.net/tis/?interval=instant&type=2&cat=1&did=18&sid28=150027&sid45=152418&format=htmls&sdate=05-Mar-2023&edate=09-Mar-2023，使用的代码如下：

Sub QueryHourlyFlowData()
'This sub will retrieve the data from the websites containing the forecast data for
'Farad Ft Churchill and Tahoe using a web query.

    'Define the Variables that are used in this macro
    Dim StartDate As Date, EndDate As Date
    Dim sDate As String, eDate As String, meURL As String
    Dim ws As Workbook
    Dim TraceCount As Long

    Set ws = ActiveWorkbook
    ws.Activate
    Sheets("HourlyFlow").Select

    Cells.ClearContents
    StartDate = Range("StartDate")
    sDate = Format(StartDate - 3, "dd-Mmm-yyyy")
    eDate = Format(StartDate, "dd-Mmm-yyyy")
    
    'Creating the URL that will be used to look up the data
    meURL = "https://www.troa.net/tis/?interval=instant&type=2&cat=1&did=18&sid28=150027&sid45=152418&format=htmls&sdate=" & sDate & "&edate=" & eDate

    With ActiveSheet.QueryTables.Add(Connection:= _
        meURL, Destination:=Range("A1"))
        .Name = "/html/body/table/tbody/tr[3]"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    
End Sub

错误原因分析

Connection参数格式错误：QueryTables.Add的Connection参数传入URL时，必须以URL;作为前缀，直接传入纯URL会触发对象定义错误，这是引发1004错误的核心原因。
变量类型定义不严谨：代码中声明ws为Workbook类型，但实际操作的是工作表，虽不直接触发错误，但会导致逻辑混乱，增加后续出错概率。
日期格式受系统区域影响：Format函数生成的月份缩写（Mmm）在非英文系统中会显示为中文，导致URL中的日期格式不符合网站要求，网站返回无效页面后触发查询失败。
QueryTable名称设置不规范：将.Name设为XPath路径/html/body/table/tbody/tr[3]不符合设计规范，名称应为自定义标识，而非页面元素路径。

修复方案

针对上述问题，修改后的代码如下：

Sub QueryHourlyFlowData()
    ' 定义变量
    Dim StartDate As Date
    Dim sDate As String, eDate As String, meURL As String
    Dim ws As Worksheet

    ' 直接引用目标工作表，避免Activate/Select操作
    Set ws = ThisWorkbook.Sheets("HourlyFlow")
    ws.Cells.ClearContents
    
    ' 获取起始日期，确保单元格"StartDate"存在且为日期类型
    StartDate = ws.Range("StartDate").Value
    ' 强制使用英文月份格式生成日期字符串
    sDate = Format(StartDate - 3, "dd-mmm-yyyy", vbEnglishUS)
    eDate = Format(StartDate, "dd-mmm-yyyy", vbEnglishUS)
    
    ' 构造查询URL
    meURL = "https://www.troa.net/tis/?interval=instant&type=2&cat=1&did=18&sid28=150027&sid45=152418&format=htmls&sdate=" & sDate & "&edate=" & eDate

    ' 创建QueryTable，注意Connection前缀要加URL;
    With ws.QueryTables.Add(Connection:="URL;" & meURL, Destination:=ws.Range("A1"))
        .Name = "HourlyFlowQuery" ' 自定义查询名称
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End Sub

额外优化说明：

移除Select/Activate操作，改用对象直接引用，提升代码稳定性和运行效率。
用vbEnglishUS参数强制生成英文月份缩写，避免系统区域设置影响日期格式。
修正Connection参数格式，符合QueryTable的官方要求。

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