Excel VBA动态Web查询批量获取链接数据及定时刷新需求

Got it, let's tackle this problem step by step. Here's a complete VBA solution that handles batch importing data from dynamic URLs in the CustomReport sheet, appending data correctly to the Orders sheet, and setting up hourly auto-refresh.

1. Core Batch Processing Macro #

This macro loops through all valid URLs in the Links column (column E) of CustomReport, imports each page's data to Orders, and appends it right after the last existing row of data. It also includes safeguards for empty URLs and edge cases like an empty Orders sheet.

Sub BatchImportOrderData()
    Dim customReportSheet As Worksheet
    Dim ordersSheet As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim targetRange As Range
    Dim url As String
    
    ' Set direct references to worksheets (avoids unreliable Select statements)
    Set customReportSheet = ThisWorkbook.Sheets("CustomReport")
    Set ordersSheet = ThisWorkbook.Sheets("Orders")
    
    ' Find the last row with data in CustomReport's Links column (E)
    lastRow = customReportSheet.Cells(customReportSheet.Rows.Count, "E").End(xlUp).Row
    
    ' Loop through each URL starting from row 2 (skip header row)
    For i = 2 To lastRow
        url = customReportSheet.Cells(i, "E").Value
        
        ' Skip empty or whitespace-only URLs
        If Trim(url) <> "" Then
            ' Find the next empty row in Orders sheet (column A)
            Set targetRange = ordersSheet.Cells(ordersSheet.Rows.Count, "A").End(xlUp).Offset(1, 0)
            
            ' If Orders is completely empty, start at A1 instead of A2
            If targetRange.Row > 1 And ordersSheet.Cells(1, "A").Value = "" Then
                Set targetRange = ordersSheet.Range("A1")
            End If
            
            ' Add and execute the web query
            With ordersSheet.QueryTables.Add(Connection:="URL;" & url, Destination:=targetRange)
                .Name = "OrderReport_" & i ' Unique name to avoid conflicts
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = False
                .RefreshOnFileOpen = False
                .BackgroundQuery = False ' Wait for each import to finish before next
                .RefreshStyle = xlOverwriteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .WebSelectionType = xlEntirePage
                .WebFormatting = xlWebFormattingAll
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = True
                .WebDisableRedirections = False
                .Refresh BackgroundQuery:=False
            End With
            
            ' Clean up: Delete the query table after importing (keeps Orders sheet tidy)
            ordersSheet.QueryTables(ordersSheet.QueryTables.Count).Delete
        End If
    Next i
    
    MsgBox "Batch import completed successfully!", vbInformation
End Sub

2. Hourly Auto-Refresh Setup #

To automate this process every hour, we'll use Application.OnTime to schedule repeated runs. We also add workbook event handlers to start the schedule when the file opens and cancel it when closing (to avoid errors).

Step 1: Add these macros to the ThisWorkbook module #

Press Alt+F11 to open the VBA editor, then double-click ThisWorkbook in the Project Explorer to paste this code:

Private Sub Workbook_Open()
    ' Start the refresh schedule 1 minute after workbook opens
    ScheduleNextRefresh
End Sub

Sub ScheduleNextRefresh()
    Dim nextRunTime As Date
    nextRunTime = Now + TimeValue("01:00:00") ' Schedule next run 1 hour from now
    ' Schedule the batch import
    Application.OnTime nextRunTime, "BatchImportOrderData"
    ' Re-schedule the next refresh to keep the cycle going
    Application.OnTime nextRunTime, "ScheduleNextRefresh"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ' Cancel any pending scheduled tasks to prevent errors
    On Error Resume Next ' Ignore if no schedule exists
    Application.OnTime Now + TimeValue("01:00:00"), "BatchImportOrderData", , False
    Application.OnTime Now + TimeValue("01:00:00"), "ScheduleNextRefresh", , False
    On Error GoTo 0
End Sub

Key Notes: #

• BackgroundQuery: Set to False to ensure each URL finishes importing before moving to the next—prevents overlapping queries that could corrupt data.
• Query Cleanup: The code deletes each query table after importing to keep Orders uncluttered. Remove that line if you want to retain queries for manual refreshes.
• Data Reset: If you want to replace old data with fresh imports each time, add ordersSheet.Cells.ClearContents at the start of BatchImportOrderData.

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