使用VBA从Internet Explorer检索URL

时间:2018-11-06 16:51:12

标签: excel vba web-scraping

我已经在Excel中编写了一些VBA代码,以从Google Maps URL检索纬度和经度并将其粘贴到工作表中的单元格中。我的问题是从Internet Explorer检索URL。在下面的代码中,我有两个示例,一个宏返回一个about:blank,好像该对象没有LocationURL属性,而另一个示例似乎正在保存所有以前的搜索,因此它循环遍历所有先前的搜索并粘贴最前面的搜索的URL。示例2使用了我在网上找到的shell建议,以将属性重新分配给oIE对象。我可以让两者都稍作工作,但两者都不能完全满足我的宏要求。

Cell(8,8)是指向我要搜索地址的Google地图的超链接,Cell(8,9)是我要在Google地图重定向后并在其中具有经度和纬度的位置粘贴URL的位置。网址。

示例1:

→ python3 color.py
['Black', 'White', 'White', 'Pink', 'Yellow', 'Black']
['Red', 'Green']
['Red', 'Red', 'Yellow', 'Red']

示例2:

Sub CommandButton1_Click()

Dim ie As Object
Dim Doc As HTMLDocument

Set ie = CreateObject("InternetExplorer.Application")

ie.Visible = True
ie.Navigate "http://www.google.com/maps?q=" & Range("I7").Value
Do
DoEvents
Loop Until ie.ReadyState = 4

Set Doc = ie.Document

Cells(8, 9).Value = ie.LocationName

End Sub

谢谢, 安德鲁

1 个答案:

答案 0 :(得分:0)

这就像循环直到document.URL更改一样简单吗?在定时循环中,我等待原始页面加载中的字符串safe=vss消失。

Option Explicit    
Public Sub GetNewURL()
    Dim IE As New InternetExplorer, newURL As String, t As Date
    Const MAX_WAIT_SEC As Long = 5

    With IE
        .Visible = True
        .navigate2 "http://www.google.com/maps?q=" & "glasgow" '<==Range("I7").Value

        While .Busy Or .readyState < 4: DoEvents: Wend
        t = Timer
        Do
            DoEvents
            newURL = .document.URL
            If Timer - t > MAX_WAIT_SEC Then Exit Do
        Loop While InStr(newURL, "safe=vss") > 0

        Debug.Print newURL       
    End With 
End Sub