找了下还是找到方法了。标准模块里放: Option ExplicitPrivate Type UUID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As Byte End TypePublic Enum IValues GetValue = 0 SetValue = 1 BtnClick = 2 End EnumPrivate Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" ( _ Destination As Any, _ ByVal Length As Long)Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As LongPrivate Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _ ByVal hWnd1 As Long, _ ByVal hWnd2 As Long, _ ByVal lpsz1 As String, _ ByVal lpsz2 As String) As LongPrivate Declare Function ObjectFromLresult Lib "oleacc" ( _ ByVal lResult As Long, _ riid As UUID, _ ByVal wParam As Long, _ ppvObject As Any) As LongPrivate Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" ( _ ByVal lpString As String) As LongPrivate Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" ( _ ByVal hWnd As Long, _ ByVal Msg As Long, _ ByVal wParam As Long, _ lParam As Any, _ ByVal fuFlags As Long, _ ByVal uTimeout As Long, _ lpdwResult As Long) As LongPrivate HtmlDoc As HTMLDocumentPublic Function Generate(ByVal hWnd As Long) As IHTMLDocument Dim ID As UUID Dim lngReg As Long Dim lngHnD As Long lngHnD = RegisterWindowMessage("WM_HTML_GETOBJECT") With ID .Data1 = &H626FC520 .Data2 = &HA41E .Data3 = &H11CF .Data4(0) = &HA7 .Data4(1) = &H31 .Data4(2) = &H0 .Data4(3) = &HA0 .Data4(4) = &HC9 .Data4(5) = &H8 .Data4(6) = &H26 .Data4(7) = &H37 End With Call SendMessageTimeout(hWnd, lngHnD, 0, 0, &H2, 2000, lngReg) Call ZeroMemory(ID, Len(ID)) Call ObjectFromLresult(lngReg, ID, 0, Generate) End Function 调用模块中方法: Option ExplicitPrivate Sub Command1_Click() Dim doc As Object Set doc = Generate(46008244) '具体的句柄
'打开指定网址 doc.parentWindow.navigate "http://www.sina.com" '方法1 ' doc.location.Replace "http://www.sina.com" '方法2 ' doc.url = "http://www.sina.com" '方法3 End Sub
Option ExplicitPrivate Type UUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End TypePublic Enum IValues
GetValue = 0
SetValue = 1
BtnClick = 2
End EnumPrivate Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" ( _
Destination As Any, _
ByVal Length As Long)Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPrivate Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As LongPrivate Declare Function ObjectFromLresult Lib "oleacc" ( _
ByVal lResult As Long, _
riid As UUID, _
ByVal wParam As Long, _
ppvObject As Any) As LongPrivate Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" ( _
ByVal lpString As String) As LongPrivate Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" ( _
ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
lParam As Any, _
ByVal fuFlags As Long, _
ByVal uTimeout As Long, _
lpdwResult As Long) As LongPrivate HtmlDoc As HTMLDocumentPublic Function Generate(ByVal hWnd As Long) As IHTMLDocument
Dim ID As UUID
Dim lngReg As Long
Dim lngHnD As Long lngHnD = RegisterWindowMessage("WM_HTML_GETOBJECT") With ID
.Data1 = &H626FC520
.Data2 = &HA41E
.Data3 = &H11CF
.Data4(0) = &HA7
.Data4(1) = &H31
.Data4(2) = &H0
.Data4(3) = &HA0
.Data4(4) = &HC9
.Data4(5) = &H8
.Data4(6) = &H26
.Data4(7) = &H37
End With Call SendMessageTimeout(hWnd, lngHnD, 0, 0, &H2, 2000, lngReg)
Call ZeroMemory(ID, Len(ID))
Call ObjectFromLresult(lngReg, ID, 0, Generate)
End Function
调用模块中方法:
Option ExplicitPrivate Sub Command1_Click()
Dim doc As Object
Set doc = Generate(46008244) '具体的句柄
'打开指定网址
doc.parentWindow.navigate "http://www.sina.com" '方法1
' doc.location.Replace "http://www.sina.com" '方法2
' doc.url = "http://www.sina.com" '方法3
End Sub