时间戳

首页 > 解决方案 > selenium v​​ba从web表中提取数据最后一位代码复制文本不起作用

excel - selenium v​​ba从web表中提取数据最后一位代码复制文本不起作用

问题描述

我一直在尝试从http://avionictools.com/icao.php导入表格结果， 使用示例 Reg 代码是 N2 我的代码添加了 Reg 代码并单击提交按钮，但我无法从表格中复制结果. 我希望将十六进制代码复制到 C 列 

Public Sub regsearch()
Dim LR1, lr2 As Long, i As Long

LR1 = Sheet1.Range("A" & Rows.Count).End(xlUp).Row



Dim data As String

Dim bot As New WebDriver
For i = 2 To 2
Sheet1.Range("A" & i).Copy 'Value is N2

Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        With clipboard
            .GetFromClipboard
            data = .getText
        End With
        'MsgBox data
bot.Start "chrome", "http://avionictools.com"


bot.Wait 2000
bot.get "/icao.php"
bot.Wait 2000


bot.FindElementByName("data").Click

bot.SendKeys data
bot.Wait 2000
bot.FindElementByXPath("//div/input").Click



bot.Wait 1000


Set Table = bot.getElementsByTagName("table").Item(0)
For Each Tr In Table.getElementsByTagName("tr")
    tdlen = Tr.getElementsByTagName("td").Length
If tdlen > 1 Then
    lr = Sheet2.Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheet1.Range("C" & i).Value = Tr.getElementsByTagName("td").Item(0).innerText
    Sheet1.Range("D" & i).Value = Tr.getElementsByTagName("td").Item(1).innerText
Else

    End If


Next Tr
Application.Wait Now + TimeValue("00:00:04")


Next
End Sub

标签： excelvbaseleniumweb-scraping

解决方案

以下似乎对我有用

Option Explicit

Public Sub GetInfo()
    Dim IE As New InternetExplorer, clipboard As Object, ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

    With IE
        .Visible = True
        .navigate "http://www.airlinecodes.co.uk/airlcodesearch.asp" '"http://www.airlinecodes.co.uk/airlcoderes.asp"

        While .Busy Or .readyState < 4: DoEvents: Wend

        .document.querySelector("[name=icaocode]").Value = "BAW"
        .document.querySelector("[name=submit]").Click

        While .Busy Or .readyState < 4: DoEvents: Wend

        clipboard.SetText .document.querySelectorAll("table").item(4).outerHTML '.getAttribute("outerHTML")
        clipboard.PutInClipboard

        .Quit
    End With

    ws.Cells(1, 1).PasteSpecial

End Sub

编辑：

回答您更改的问题：

Option Explicit
Public Sub test()
    Dim bot As New ChromeDriver, ws As Worksheet, text As String, i As Long
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    With bot
        .Start
        .get "http://avionictools.com/icao.php"
        For i = 1 To 2
        .FindElementByCss("input[name=data]").SendKeys "N" & CStr(i)
        .FindElementByCss("[type=submit]").submit

        text = .FindElementsByTag("table")(1).FindElementsByTag("tr")(2).FindElementsByTag("td")(1).text
        ws.Cells(i, 1) = Split(text, Chr$(10))(1)
        .FindElementByCss("input[name=data]").Clear
        Next
        .Quit
    End With
End Sub

推荐阅读