从网站获取数据

Question

这个问题对我来说太难解决了，我试过了，目前还没有解决...

下面的代码遍历 O 列中的值，并用该值更改网址的一部分，然后将数据提取到 excel 但有时如果某些搜索 returns 没有结果，那么我我收到错误 1004 并且循环停止并且无法转到下一个值...

下图显示了O列的四个值和错误信息：

O1 = N1010W
O2 = N22NA
O3 = N2345I
O4 = N992AN

在值 O3 上，出现错误 1004，循环停止。有没有办法 skip/cancel 该错误并让搜索转到下一个 (O4) 值？因为每次搜索的数据都进入范围 (A1:F1)、(B2:F2) 等，当错误显示为 O3 值时，该范围 (A3:F3) 中的所有单元格应填充任何单词，例如， "not found"

Option Explicit

 Sub Getdata()



Dim lastrow As Long, x As Long

Application.ScreenUpdating = False


 With Worksheets("Sheet2")

    lastrow = .Range("O" & Rows.Count).End(xlUp).Row

    For x = 2 To lastrow



        RequeryLandings .Cells(x, "O")

    Next

End With

Application.ScreenUpdating = True

End Sub

Sub RequeryLandings(address As String)

Dim ws As Worksheet



Dim NewRow As Long

With Worksheets("Sheet2")
Set ws = ActiveWorkbook.Sheets("Sheet1")




   With ws.QueryTables.Add(Connection:= _
    "URL;http://www.airport-data.com/aircraft/" & address & ".html",            Destination:=ws.Range( _
    "$A"))
    .Name = "N1010W"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = False
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingAll
    .WebTables = "2"
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False

    End With
     Range("A14").Select
With ws.QueryTables.Add(Connection:= _
    "URL;http://www.airport-data.com/aircraft/" & address & ".html",      Destination:=Sheets("Sheet1").Range( _
    "$A"))
    .Name = "N1010W_2"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = False
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingAll
    .WebTables = "3"
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False

End With



    DoEvents



    Dim strSplit() As String
Dim cell As Range



For Each cell In ws.Range("B2:B200")

If (cell.Value <> vbNullString) Then

    cell.Value = Split(cell.Value, "   Search")(0)

End If

Next cell



End With


    'Copy to Another Sheet

 With Worksheets("Sheet2")
NewRow = .Range("D" & Rows.Count).End(xlUp).Row + 1


If ws.Range("A54") = "Notice:" Then
    Sheets("Sheet1").Range("A54:A55").EntireRow.Delete
End If

.Range("A" & NewRow) = ws.Range("B1")
.Range("B" & NewRow) = ws.Range("B2")
.Range("C" & NewRow) = ws.Range("B4")
.Range("D" & NewRow) = ws.Range("B12")
.Range("E" & NewRow) = ws.Range("B3")


  If ws.Range("A14") = "Certification Class:" Then
 .Range("F" & NewRow) = ws.Range("B14")
  Else
     .Range("F" & NewRow) = "Unknown"
 End If



    End With





   ActiveWorkbook.Sheets("Sheet1").Range("A1:P100") = Null

   Sheets("Sheet2").Activate

   Sheets("Sheet2").Range("G1").Select




  End Sub

Answer 1

您将要使用 On Error Resume Next。这实际上并没有修复错误，但它确实告诉代码继续。在你打开子 RequeryLandings 中的连接之前，我将你的代码复制到我的 sheet 和运行中

'The Error line, after you set ws = activeWorkbook.Sheets("Sheet1")
On Error Resume Next

With ws.QueryTables.Add(Connection:= _
"URL;http://www.airport-data.com/aircraft/" & address & ".html", Destination:=ws.range( _
"$A"))
.Name = "N1010W"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingAll
.WebTables = "2"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False

End With

从网站获取数据

Fetching data from website

excel

vba

fetch

web