所需的Web查詢和錯誤處理程序

Question

我的MAC ID的列表循環。我試圖找到所有供應商的詳細信息。我嘗試了一個，但我需要它，直到列A（所有我提到的MAC ID）的末尾。如果找不到，那麼只需跳過，它必須移動到下一個循環並粘貼到下面。我做了一個。

Sub FindMACTest() 

    With ActiveSheet.QueryTables.Add(Connection:= _ 
     "URL;http://www.coffer.com/mac_find/?string=" & Range("A1"), Destination:=Range _ 
     ("$I$1")) 
     .FieldNames = True 
     .RowNumbers = False 
     .FillAdjacentFormulas = False 
     .PreserveFormatting = True 
     .RefreshOnFileOpen = False 
     .BackgroundQuery = True 
     .RefreshStyle = xlInsertDeleteCells 
     .SavePassword = False 
     .SaveData = True 
     .AdjustColumnWidth = True 
     .RefreshPeriod = 0 
     .WebSelectionType = xlSpecifiedTables 
     .WebFormatting = xlWebFormattingNone 
     .WebTables = "1" 
     .WebPreFormattedTextToColumns = True 
     .WebConsecutiveDelimitersAsOne = True 
     .WebSingleBlockTextImport = False 
     .WebDisableDateRecognition = False 
     .WebDisableRedirections = False 
     .Refresh BackgroundQuery:=False 
    End With 
End Sub 

Answer 1

我會謙卑地建議你贊成MSXML2.XMLHTTP對象爲你的網頁抓取的放棄.QueryTables。 VBA的檢索網頁數據庫沒有更快更清潔的工具。

此代碼要求您通過VBE的工具的Microsoft HTML對象庫添加到您的項目►引用命令。

Sub retrieveMAC() 
    Dim htmlBDY As New HTMLDocument 
    Dim m As String, u As String, rw As Long, iTD As Long, ws As Worksheet 

    Set ws = ActiveSheet 

    With ws 
     For rw = 1 To .Cells(Rows.Count, 1).End(xlUp).Row 
      m = UCase(Replace(Left$(.Cells(rw, 1).Value2, 8), Chr(45), vbNullString)) 
      u = "http://www.coffer.com/mac_find/?string=" & m 
      With CreateObject("MSXML2.XMLHTTP") 
       On Error Resume Next 
       .Open "GET", u, False 
       .Send 

       If .Status <> 200 Then 
        Debug.Print .Status 
        GoTo CleanUp 
       End If 

       htmlBDY.body.innerHTML = vbNullString 
       htmlBDY.body.innerHTML = .responseText 
       With htmlBDY 
        For iTD = 0 To (.getElementsByTagName("td").Length - 1) 
         With .getElementsByTagName("td")(iTD) 
          If UCase(.innerText) = m Then 
           ws.Cells(rw, 9) = .NextSibling.innerText 
           Exit For 
          End If 
         End With 
        Next iTD 
       End With 

      End With 
     Next rw 
    End With 
CleanUp: 
    Set htmlBDY = Nothing 

End Sub