将网站导入/抓取到Excel [英] Importing/scraping an website into excel

问题描述

我正在尝试从数据库中抓取一些数据，并且已经设置好了.我在IE中寻找一个让我登录到数据库的选项卡，然后通过vba将查询链接粘贴到该选项卡中.但是，如何提取从IE选项卡返回的数据，并将其放入Excel单元格或数组中.

I am trying to scrape some data from a database, and I have it pretty much set. I look in IE for a tab that has me logged in into the database, and paste the query link there through vba. But how do I extract the data that it returns from the IE tab and put that into an excel cell or array.

这是打开查询的代码:

Sub import()
Dim row As Integer
Dim strTargetFile As String
Dim wb As Workbook
Dim test As String
Dim ie As Object


Call Fill_Array_Cultivar

 For row = 3 To 4

    Sheets.Add.Name = Cultivar_Array(row, 1)
    strTargetFile = "https://www3.wipo.int/pluto/user/jsp/select.jsp?fl=app_date%2Cden_info%2Cden_final&hl=false&json.nl=map&wt=json&type=upov&start=0&qi=3-nNCXQ6etEVv184O9nnd5yg%3D%3D&q=cc%3AIT%20AND%20latin_name%3A(zea%20mays)%20AND%20den_info%3A" & Trim(Cultivar_Array(row, 1)) & "&facet=false"

        Set ie = GetIE("https://www3.wipo.int" & "*")
         If Not ie Is Nothing Then

            ie.navigate (strTargetFile)

Else
    MsgBox "IE not found!"
End If
Next row

End Sub

这是合适的功能:

'Find an IE window with a matching (partial) URL
'Assumes no frames.
Function GetIE(sAddress As String) As Object

Dim objShell As Object, objShellWindows As Object, o As Object
Dim retVal As Object, sURL As String


    Set retVal = Nothing
    Set objShell = CreateObject("Shell.Application")
    Set objShellWindows = objShell.Windows

 'see if IE is already open
    For Each o In objShellWindows
        sURL = ""
        On Error Resume Next
        sURL = o.document.Location
        On Error GoTo 0
        If sURL <> "" Then
            If sURL Like sAddress & "*" Then
              Set retVal = o
              Exit For
            End If
        End If
    Next o

Set GetIE = retVal
End Function

该网站返回给我的是白页，上面有一行文字.这是一个示例:

What the website returns to me is a white page with a line of text. Here is an example:

 {"response":{"start":0,"docs":[{"den_final":"Abacus","app_date":"1998-01-13T22:59:59Z"}],"numFound":1},"qi":"3-nNCXQ6etEVv184O9nnd5yg==","sv":"bswa2.wipo.int","lastUpdated":1436333633993}

PS.我还尝试使用importxml函数，它将导入网站，但仅导入错误页面，因为它无法识别出我已登录.

PS. I also tried using the importxml function, it will import the website, but only an error page, as it does not recognize me as logged in.

推荐答案

我找到了解决方案，它很简单，但是很难找到. 我可以只获取ie.Document.body.innertext，这就是我需要的所有文本. 请参阅我在下面更新的代码:

I found the solution, which was fairly simple but hard to find. I can just grab the ie.Document.body.innertext which is all the text I need. See the code I updated below:

Sub import()
Dim row As Integer
Dim strTargetFile As String
Dim wb As Workbook
Dim test As String
Dim ie As Object
Dim pageText As String

Call Fill_Array_Cultivar

For row = 3 To 4

    Sheets.Add.Name = Cultivar_Array(row, 1)
    strTargetFile = "https://www3.wipo.int/pluto/user/jsp/select.jsp?fl=app_date%2Cden_info%2Cden_final&hl=false&json.nl=map&wt=json&type=upov&start=0&qi=3-nNCXQ6etEVv184O9nnd5yg%3D%3D&q=cc%3AIT%20AND%20latin_name%3A(zea%20mays)%20AND%20den_info%3A" & Trim(Cultivar_Array(row, 1)) & "&facet=false"

    Set ie = GetIE("https://www3.wipo.int" & "*")
    If Not ie Is Nothing Then
        ie.navigate (strTargetFile)

        Do Until ie.ReadyState = 4: DoEvents: Loop

        pageText = ie.Document.body.innertext
        ActiveSheet.Cells(1, 1) = pageText
        pageText = Empty
    Else
        MsgBox "IE not found!"
    End If
Next row
End Sub

这篇关于将网站导入/抓取到Excel的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！