excel 巨集抓資料

Sub FetchTurlockID() Dim http As Object Dim html As Object Dim i As Long Dim ws As Worksheet Dim baseUrl As String Dim idPrefix As String Dim startID As Long Dim endID As Long Dim currentID As String Dim rowIndex As Long Dim pageContent As String Dim delay As Single ' 初始化參數 Set http = CreateObject("MSXML2.XMLHTTP") Set html = CreateObject("HTMLFILE") Set ws = ThisWorkbook.Sheets(1) ' 選擇第一個工作表 baseUrl = "https://track.omniparcel.com/?id=" idPrefix = "SEKTW0000" startID = 196000 endID = 199999 rowIndex = 2 ' 從第二行開始填入數據（第一行可用於標題） delay = 0.5 ' 延遲 0.5 秒（可調整） ' 添加表格標題 ws.Cells(1, 1).Value = "ID" ws.Cells(1, 2).Value = "Location" ' 循環處理每個 ID For i = startID To endID currentID = idPrefix & Format(i, "000000") ' 更新狀態顯示 Application.StatusBar = "正在處理 ID: " & currentID ' 發送 HTTP 請求 http.Open "GET", baseUrl & currentID, False http.Send ' 將回應載入 HTML 物件 If http.Status = 200 Then html.body.innerHTML = http.responseText ' 提取網頁中的文字 On Error Resume Next pageContent = html.body.innerText ' 提取整頁文字 On Error GoTo 0 ' 判斷是否包含 "TURLOCK, CA, US" If InStr(pageContent, "TURLOCK, CA, US") > 0 Then ' 將符合條件的 ID 和文字貼到 Excel 表格中 ws.Cells(rowIndex, 1).Value = currentID ws.Cells(rowIndex, 2).Value = "TURLOCK, CA, US" rowIndex = rowIndex + 1 End If Else Debug.Print "HTTP 請求失敗，狀態碼: " & http.Status End If ' 延遲以避免頻繁請求 ' 防止 Excel 卡住 DoEvents Next i ' 清除狀態欄 Application.StatusBar = False MsgBox "資料抓取完成！", vbInformation End Sub