Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 'Findwindow函数的功能是找到当前运行的IE窗口的url地址的句柄
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 'FindwindowEx函数的功能是找到子窗体的句柄
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
Private Const WM_GETTEXT = &HD
Private Sub Command1_Click()
getcurrenturl
End Sub
Sub getcurrenturl(Optional ByRef URL As String)
Dim hwnd As Long '设定一个长整形变量用来接收函数返回值
hwnd = 0 '初始化
hwnd = FindWindowEx(hwnd, 0, "IEFrame", vbNullString) 'IE窗口句柄
hwnd = FindWindowEx(hwnd, 0, "Workerw", vbNullString) 'IE窗口的工作区句柄
hwnd = FindWindowEx(hwnd, 0, "ReBarWindow32", vbNullString) 'IE窗口的菜单栏句柄
hwnd = FindWindowEx(hwnd, 0, "ComboBoxEx32", vbNullString) 'IE窗口下拉菜单句柄
hwnd = FindWindowEx(hwnd, 0, "ComboBox", vbNullString) 'IE窗口下拉菜单当前项句柄
hwnd = FindWindowEx(hwnd, 0, "Edit", vbNullString) ''IE窗口下拉菜单编辑框句柄
URL = String(1024, Chr(0)) '初始化字符串
SendMessageByString hwnd, WM_GETTEXT, 1025, URL '向系统发送获得IE窗体地址栏中的字符串命令
URL = Split(URL, Chr(0))(0) '根据 URL 长度得到 URL 值
MsgBox URL '显示IE当前网址
End Sub
(出处: