使用VBA从Urls获取网站数据

时间:2014-06-24 11:54:27

标签: excel vba excel-vba excel-formula export-to-excel

我在Excel工作表中存储了多个网址。我想将数据驻留在特定的div标签中。对于一个网站,它工作正常

Sub Cityline()

Dim IE As Object

Set IE = CreateObject("Internetexplorer.application")

IE.Visible = True

IE.navigate "http://Someurl.com/bla/bla/bla"

Do While IE.busy

DoEvents

Loop

Do

DoEvents

Dim Doc As Object

Set Doc = IE.Document

Dim workout As String

workout = Doc.getElementsByClassName("CLASS_NAME_OF_DATA")(0).innertext

Range("A2") = workout

Loop

End Sub

我使用下面的代码循环遍历所有网址,但它不起作用

Sub GetData() 
    Dim oHtm As Object: Set oHtm = CreateObject("HTMLFile") 
    Dim req As Object: Set req = CreateObject("msxml2.xmlhttp") 
     Dim oRow As Object 
     Dim oCell As Range 
    Dim url As String 
   Dim y As Long, x As Long 

x = 1 
For Each oCell In Sheets("sheet1").Range("A2:A340") 
    req.Open "GET", oCell.Offset(, 1).Value, False 
    req.send 
    With oHtm 
        .body.innerhtml = req.responsetext 
        With .getelementsbytagname("table")(1) 
            With Sheets(1) 
                .Cells(x, 1).Value = oCell.Offset(, -1).Value 
                .Cells(x, 2).Value = oCell.Value 
            End With 
            y = 3 
            For Each oRow In .Rows 
                Sheets(1).Cells(x, y).Value = oRow.Cells(1).innertext 
                y = y + 1 
            Next oRow 
        End With 
    End With 
    x = x + 1 
Next oCell 

End Sub


但它不起作用 任何人都可以建议我哪里出错了?

我使用了Fetching Data from multiple URLs,但它对我不起作用。 请指导我如何一次从所有网址获取数据

1 个答案:

答案 0 :(得分:0)

我是SO的新手,如果这应该在评论中(我无法让它适合),请向mod道歉。

我同意Silver的评论,但我认为我会建议一种可能有所帮助的不同方法。如果您在单元格列中包含URL,则可以创建自定义VBA函数,该函数将从HTML中提取相关数据。只需在URL右侧的单元格中使用此函数,即可从HTML返回相关数据。一个例子是:

Public Function GetHTMLData(SiteURL As String, FieldSearch As String) As String
Dim IE As Object
Dim BodyHTML As String
Dim FieldStart As Integer
Dim FieldEnd As Integer

Set IE = CreateObject("InternetExplorer.Application")

With IE
.Navigate SiteURL
Do While .Busy Or .ReadyState <> 4
DoEvents
Loop

BodyHTML = IIf(StrComp(.Document.Title, "Cannot find server", vbTextCompare) = 0, _
    vbNullString, .Document.body.innerhtml)
FieldStart = InStr(1, BodyHTML, FieldSearch) + Len(FieldSearch) + 12
FieldEnd = InStr(FieldStart, BodyHTML, "<")

GetHTMLData = Mid(BodyHTML, FieldStart, FieldEnd - FieldStart)
.Quit
End With

Set IE = Nothing
End Function

上面的函数有2个输入参数:URL和将在HTML中搜索的字符串。然后,它将从HTML中返回一个字符串,从搜索参数后的12个字符开始,到下面的'&lt;'结束在HTML中。

希望有所帮助。

相关问题