使用VBA从Internet Explorer检索URL [英] Retrieving a URL from Internet Explorer with VBA

问题描述

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

I have written some VBA code in Excel to retrieve the latitude and longitude from a Google Maps URL and paste it into a cell in my worksheet. My problem is in retrieving the URL from internet explorer. Below I have two examples of my code, one macro returns an about:blank as though the object doesn't have the LocationURL property, and the other example seems like it is saving all of my previous searches, so it cycles through all of my previous searches and pastes the very first searches' URL. Example 2 uses a shell suggestion that I found online to reassign the properties to the oIE object. I can get both to slightly work, but neither will do exactly what I need from the macro.

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

Cell(8,8) is a hyperlink to google maps where I'm searching an address, and Cell(8,9) is where I want to paste the URL after google maps has redirected and has the latitude and longitude in the URL.

示例1:

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

示例2:

Sub Macro()
Dim oIE, oShell, objShellWindows, strPath, X

strPath = Cells(8, 8)

Set oIE = CreateObject("InternetExplorer.Application")

'This is to resolve oIE.navigate "about:blank" issue
oIE.Top = 0
oIE.Left = 0
oIE.Width = 500
oIE.Height = 500

oIE.Navigate strPath

Do While oIE.Busy And oIE.ReadyState < 2
    DoEvents
Loop

'Reassigning oIE.LocationName & vbCrLf & oIE.LocationURL values after redirect in IE

Set oShell = CreateObject("WScript.Shell")
Set objShellWindows = CreateObject("Shell.Application").Windows
For X = objShellWindows.Count - 1 To 0 Step -1
    Set oIE = objShellWindows.Item(X)
    If Not oIE Is Nothing Then
        If StrComp(oIE.LocationURL, strPath, 1) = 0 Then
            Do While oIE.Busy And oIE.ReadyState < 2
                DoEvents
            Loop
            oIE.Visible = 2
            Exit For
        End If
    End If
    Cells(8, 9).Value = oIE.LocationURL
    Set oIE = Nothing
Next
Set objShellWindows = Nothing
Set oIE = Nothing

End Sub

谢谢，安德鲁

推荐答案

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

Is this as simple as looping until the document.URL changes? In my timed loop I wait for the string safe=vss in the original page load to disappear.

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

这篇关于使用VBA从Internet Explorer检索URL的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！