作者:乔山办公网日期:
返回目录:excel表格制作
With IE
.navigate URL
.Visible = True
.document.forms(0).submit
End With
如果不是你想要的知,说明目标网页不只有一个form,需要你去目标网页,点f12,找你想要的那个。道当然你内也可以通过更改forms(x)去一个个试,总能找到你要的那个。当然你也可以去找那个按钮容的值,用按钮点击的方法。
ie.document.getElementById(按钮的值).click
ActiveSheet.WebBrowser1.Document.form1.Button1.Click
页面.webbrowser控件.网页.表单名.按钮名.点击
Private Sub iOpenXLS()
Dim ph As String, bk As Workbook
ph = "D:\我的抄文档\Book1.xls" '设置excel文件地址
Set bk = Workbooks.Open(ph) '打开这个袭excel文档
With bk.Worksheets("sheet1") '操作知sheet表
.Range("a1:b1").Merge '合并单元格a1:b1
End With
bk.Close True '保存并关道闭这个excel文件
End Sub
代码如下:
Sub s()
On Error Resume Next
Dim pth$, fn$, wb As Workbook
pth = "d:\test\" '在这知里输入要打开的工作簿的完道整路径
fn = "a.xlsx" '在这里输入要打开的工作簿的文件名,包括扩展名
Set wb = Application.Workbooks.Open(pth & fn)
If wb Is Nothing Then MsgBox ("文件打开失败回,请检查" & pth & fn & "是否存在!"): Exit Sub
'在此添加操作代码答
wb.Close True '如果无需保存,本参数用false
End Sub
'准备工作:1.用IE打开百度
2.调用函数GetIE
'代码搜索标题包含百度的IE窗口,e69da5e6ba907a686964616f364然后控制打开hao123,最后保存为c:\myhtml.txt
Option Explicit
'
' 工程要引用 "Microsoft HTML Object Library"
'
Private Type UUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function GetClassName Lib "user32" _
Alias "GetClassNameA" ( _
ByVal hWnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Boolean
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, lParam As Long) As Long
Private Declare Function RegisterWindowMessage Lib "user32" _
Alias "RegisterWindowMessageA" ( _
ByVal lpString As String) As Long
Private 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 Long
Private Const SMTO_ABORTIFHUNG = &H2
Private Declare Function ObjectFromLresult Lib "oleacc" ( _
ByVal lResult As Long, _
riid As UUID, _
ByVal wParam As Long, _
ppvObject As Any) As Long
Dim IEhwnd As Long
Dim IEserver As Long
'
' IEDOMFromhWnd
'
' Returns the IHTMLDocument interface from a WebBrowser window
'
' hWnd - Window handle of the control
'
Function IEDOMFromhWnd() As IHTMLDocument
Dim IID_IHTMLDocument As UUID
Dim hWnd As Long
Dim lRes As Long
Dim lMsg As Long
Dim hr As Long
' Find a child IE server window
EnumWindows AddressOf EnumWindowProc, ByVal 0
If IEhwnd Then EnumChildWindows IEhwnd, AddressOf EnumChildProc, ByVal 0
If IEserver Then hWnd = IEserver Else Exit Function
' Register the message
lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
' Get the object pointer
Call SendMessageTimeout(hWnd, lMsg, 0, 0, _
SMTO_ABORTIFHUNG, 1000, lRes)
If lRes Then
' Initialize the interface ID
With IID_IHTMLDocument
.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
' Get the object from lRes
hr = ObjectFromLresult(lRes, IID_IHTMLDocument, 0, IEDOMFromhWnd)
End If
End Function
Private Function IsIEServerWindow(ByVal hWnd As Long) As Boolean
Dim lRes As Long
Dim sClassName As String
sClassName = GetClsName(hWnd)
IsIEServerWindow = StrComp(sClassName, "Internet Explorer_Server", vbTextCompare) = 0
End Function
'返回窗口类名
Public Function GetClsName(ByVal hWnd As Long) As String
Dim lRes As Long
Dim sClassName As String
sClassName = String$(200, 0)
lRes = GetClassName(hWnd, sClassName, Len(sClassName))
GetClsName = Left$(sClassName, lRes)
End Function
'返回窗口标题
Public Function GetWinTitle(ByVal lhWnd As Long) As String
Dim MyStr As String
MyStr = String(200, Chr$(0))
GetWindowText lhWnd, MyStr, 200
GetWinTitle = Left(MyStr, InStr(MyStr, Chr$(0)) - 1)
End Function
Function EnumWindowProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
Dim sIEtitle As String
sIEtitle = GetWinTitle(hWnd)
If InStr(1, sIEtitle, "百度") Then '搜索标题包含baidu的窗口
IEhwnd = hWnd
Else
EnumWindowProc = 1
End If
End Function
Function EnumChildProc(ByVal hWnd As Long, lParam As Long) As Long
If IsIEServerWindow(hWnd) Then
IEserver = hWnd
Else
EnumChildProc = 1
End If
End Function
Function GetIE() As Long
Dim Doc As IHTMLDocument2
Dim s As String
Set Doc = IEDOMFromhWnd
If Not Doc Is Nothing Then
Doc.url = "http://" '打开网页
Do Until Doc.readyState = "complete"
DoEvents
Loop
s = Doc.body.innerHTML
Open "c:\myhtml.txt" For Output As #1
Print #1, s
Close
End If
End Function