Web查询和error handling程序所需的循环

我有MAC ID的列表。 我试图find所有的供应商的细节。 我尝试了一个，但我需要它，直到A列（所有MAC ID我提到的地方）结束。 如果没有find，那么只需跳过，它必须移动到下一个循环，并粘贴到下面。 我做了一个。

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

我会虚心地build议你放弃.QueryTables ，为你的网页抓取MSXML2.XMLHTTP对象。 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