![](/img/trans.png)
[英]VBA / Internet Explorer: Capture Resulting URL From OnClick Event
[英]Retrieving a URL from Internet Explorer with VBA
我已經在Excel中編寫了一些VBA代碼,以從Google Maps URL檢索緯度和經度並將其粘貼到工作表中的單元格中。 我的問題是從Internet Explorer檢索URL。 在下面的代碼中,我有兩個示例,一個宏返回一個about:blank,好像該對象沒有LocationURL屬性,而另一個示例似乎正在保存所有以前的搜索,因此它循環遍歷所有先前的搜索並粘貼最前面的搜索的URL。 示例2使用了我在網上找到的shell建議,以將屬性重新分配給oIE對象。 我可以使兩者都稍作工作,但兩者都不能完全滿足我的宏要求。
Cell(8,8)是指向我要搜索地址的Google地圖的超鏈接,Cell(8,9)是我要在Google地圖重定向后在URL中包含緯度和經度的位置粘貼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
消失。
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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.