从Web抓取到Excel时复制数据时出错

时间:2020-04-25 04:13:01

标签: excel vba web-scraping

我正在寻找您的编码方面的帮助,以将数据从Web提取到Excel。

通过网络获取数据:

https://eport.saigonnewport.com.vn/Pages/Common/Containers_new

  • 获取数据的步骤:

将“CátLái”放入“ Khuvựcgiaonhận集装箱”(选择海港)

将容器号放入“容器”字段

取消选择“Chỉvòngluânchuyểncuối”以显示数据表中的所有行

点击搜索以显示数据表-搜索容器信息的结果

问题: 从网上抓取到Excel中每一行的数据(分别与 找到的每个容器号)似乎与之前的容器号相同 结果该容器号的WHILE信息可以为空。对于 示例:重复事件时间2“ 10/4/2020 3:07:00 PM” 容器“ TEMU3311320”,而该容器没有事件时间 2。

希望您能给我任何建议以解决此重复问题。随附Excel文件供您参考。谢谢。

Sub PullDataFromWeb()
  Dim IE As Object, W As Excel.Worksheet
  Dim doc As HTMLDocument
  Dim lastRow As Integer, b As Boolean, tmp As String
  Dim lis, li
  Set W = ThisWorkbook.Sheets("Sheet1")
  Set IE = VBA.CreateObject("InternetExplorer.Application")
  IE.Visible = True   'hien cua so IE
  IE.navigate "https://eport.saigonnewport.com.vn/Pages/Common/Containers_new"
  Do While IE.Busy Or IE.readyState <> 4      'doi IE chay xong
    Application.Wait DateAdd("s", 1, Now)
  Loop
  Set doc = IE.document

  lastRow = W.Range("B" & W.UsedRange.Rows.Count + 2).End(xlUp).Row        'dong cuoi cung trong cot B container
  If lastRow < 2 Then GoTo Ends
  On Error Resume Next
  For intRow = 2 To lastRow     'tu dong toi dong
    b = False
    b = W.Range("I" & intRow).Value Like "[Yy]"
    If W.Range("B" & intRow).Value <> "" And Not b Then
      doc.getElementById("txtItemNo_I").Value = W.Range("B" & intRow).Value 'so cont
      doc.getElementById("cbSite_VI").Value = W.Range("A" & intRow).Value
      doc.getElementById("chkInYard_I").Checked = False
      doc.getElementById("ContentPlaceHolder2_btnSearch").Click 'click Search
      '----------------------------------------------
      Do While IE.Busy Or IE.readyState <> 4
        Application.Wait DateAdd("s", 1, Now)
      Loop
      '----------------------------------------------
      strFindContainer = doc.getElementById("ContentPlaceHolder2_lblNotice").innerText
      W.Range("H" & intRow) = strFindContainer
      If strFindContainer Like "T*m th*y * container*" Then
        strEventtime1 = doc.getElementById("grdContainer_DXDataRow0").Cells(0).innerText
        strEventtype1 = doc.getElementById("grdContainer_DXDataRow0").Cells(1).innerText
        strLocation1 = doc.getElementById("grdContainer_DXDataRow0").Cells(2).innerText
        strEventtime2 = doc.getElementById("grdContainer_DXDataRow1").Cells(0).innerText
        strEventtype2 = doc.getElementById("grdContainer_DXDataRow1").Cells(1).innerText
        W.Range("C" & intRow) _
          .Resize(, 5).Value = Array(strEventtime1, strEventtype1, strLocation1, _
                         strEventtime2, strEventtype2)
      End If
    End If
  Next
Ends:
  IE.Quit
  Set IE = Nothing    'Cleaning up
  Set objElement = Nothing
  Set objCollection = Nothing
  Application.StatusBar = ""
  Application.DisplayAlerts = True
End Sub

1 个答案:

答案 0 :(得分:0)

在最后一个Next之前,请确保将所有相关的字符串变量分配给vbNullstring,即Array(strEventtime1, strEventtype1, strLocation1, strEventtime2, strEventtype2)中的变量,因为它位于If中,然后是If未满足的先前值将保留在以后的循环迭代中。