Получение URL из адресной строки Microsoft Internet Explorer.
Примечание: не всегда у меня данный код срабатывал.
Закройте все окна Internet Explorer, запустите программу, откройте любую htm-страницу, нажмите на кнопку в вашей программе.

Private Declare Function shellexecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessageLong& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
Private Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Const WM_USER = &H400
Const EM_LIMITTEXT = WM_USER + 21
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const EM_GETLINECOUNT = &HBA
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINELENGTH = &HC1

Private Sub Command1_Click()
On Error GoTo CallErrorA
Dim iPos As Integer
Dim sClassName As String
Dim GetAddressText As String
Dim lhwnd As Long
Dim WindowHandle As Long
lhwnd = 0
sClassName = ("IEFrame")
lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
sClassName = ("WorkerA")
lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
sClassName = ("ReBarWindow32")
lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
sClassName = ("ComboBoxEx32")
lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
sClassName = ("ComboBox")
lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
sClassName = ("Edit")
lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
WindowHandle& = lhwnd
Dim buffer As String, TextLength As Long
TextLength& = SendMessage(WindowHandle&, WM_GETTEXTLENGTH, 0&, 0&)
buffer$ = String(TextLength&, 0&)
Call SendMessageByString(WindowHandle&, WM_GETTEXT, TextLength& + 1, buffer$)
MsgBox buffer$
Exit Sub
CallErrorA:
MsgBox Err.Description
Err.Clear