'---------------------------------------------------------------------------------------
' Procedure : URLs_of_IE_windows
' Author : mellon (based on Vladimir Zakharov material)
' Date : 22/10/2014
' Purpose :To identify URLs in currently open IE Browser and list the Title and URL to immediate window.
'
' *** This does NOT find Firefox, Chrome applications
' *** ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
' Note: If you want all open Windows including Windows Explorer, then
' remove the criteria (the IF and End If) on the App application.
'
' Original code from: Vladimir Zakharov
'---------------------------------------------------------------------------------------
'
Sub URLs_of_IE_windows()
Dim a() As Variant
Dim w As Variant
Dim App As String, Title As String, Url As String
Dim i As Long, j As Long
10 On Error GoTo URLs_of_IE_windows_Error
20 With CreateObject("Shell.Application")
30 ReDim a(1 To .Windows.Count, 1 To 2)
40 On Error Resume Next
50 For Each w In .Windows
60 App = w.Application
70 If App = "Internet Explorer" Then ' remove this line to get all open explorer windows
80 Url = Replace(w.LocationURL, "%20", " ")
90 Title = Replace(w.LocationName, "%20", " ")
100 i = i + 1
110 a(i, 1) = Title
120 a(i, 2) = Url
130 Debug.Print Title, Url
140 App = vbNullString
150 End If ' remove this line to get all open explorer windows
160 Next
170 End With
180 On Error GoTo 0
190 Exit Sub
URLs_of_IE_windows_Error:
200 MsgBox "Error " & Err.number & " (" & Err.Description & ") in procedure URLs_of_IE_windows of Module IEWindows"
End Sub