ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 EH云课堂直播课程免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 7038|回复: 8

[讨论] (急)如何取得弹出网页的控制权及其innerHtml源代码?

[复制链接]

TA的精华主题

TA的得分主题

发表于 2012-4-23 15:13 | 显示全部楼层 |阅读模式
学习了坛子里的“网页数据下载与控制”一文,很有体会,在运用中也很有收获。但对以下内容进行测试时,仍然无法将ie控制权转移到新的ie窗口中,即在使用以下代码时无法正常取得弹出的网页的innerHtml代码?得到的仍然是原ie窗口页面的源代码。我无法将焦点移动到新弹出的窗口中并对其进行实质性控制,因我需要得到并分析弹出的结果窗口中网页的innerhtml源代码,并点击其中的链接和按钮,以完成最终的生成与下载操作,请高手赐教,最好能给个例子,谢谢主!!我遇到的网站是用javascript编程,在其function 中使用了大量的window.open,不断地开窗口(真是变态!)




set dmt = ie.document
debug.print  dmt.body.innerhtml
'==========================
'以下为引用文章中的段落:
使用IE
1、如果不想使用WebBrowser,而想使用Internet Explorer,或者“结果网页”是新窗口而“被迫”使用,控制起来也还比较方便。
Dim IEPL As Object
Set IEPL = CreateObject("InternetExplorer.Application")
IEPL.Visible = False        ‘隐藏
‘打开网页
URLstr=”http://www.XXX.XXX”
IEPL.Navigate URLstr
‘与webbrowser一样,当页面调用完毕时,发生DocumentComplete事件。
‘读Innerhtml
……
IEPL.Quit                   ‘关闭
或:
Shell ("C:\Program Files\Internet Explorer\IEXPLORE.exe about:blank")
遍历已打开的IE窗口,通过窗口标题找到刚才打开的IE(或“结果网页”新窗口),恢复对IE的控制。
‘遍历已打开的IE窗口(经测试可以得到指定窗口的句柄、名字和链接!)
    Dim dWinFolder As New ShellWindows
    Dim objIE As Object
    Dim Czpmxurl As String, Czpmxname As String   
   
    For Each objIE In dWinFolder
        Czpmxname = objIE.LocationName            ‘标题
        If InStr(Czpmxname, "查询结果") Then
            Zdurl = True
        End If
    Next
    If Zdurl then         ‘找到了
    objIE.application.Visible = False        ‘隐藏
Czpmxurl = objIE.LocationURL          ‘网址
‘读Innerhtml(问题在此处)
如何重新取得新弹出ie窗体的控制权,得到其innerhtml?使用了API函数:FindWindow ,SetForegroundWindow
'---------------------以下是引用文中代码取得焦点,但后面的代码应如何写?才能得到指定查询结果ie窗体的源代码innerhtml?

Czpmxhwnd = FindWindow(vbNullString, "http://www.XX.XX - 查询结果 - Microsoft Internet Explorer")       ‘根据窗口标题查找,找到后返回句柄
    If Czpmxhwnd = 0 Then
            MsgBox "未找到", vbOKOnly, "提示"
            Exit Sub
    End If
    aa = SetForegroundWindow(Czpmxhwnd)    ‘将网页调到前台
    Sleep 100
   mouse_event MOUSEEVENTF_RIGHTDOWN Or MOUSEEVENTF_RIGHTUP, 0&, 0&, 0, 0  ‘模拟鼠标点击,设置焦点
        ……    end ifobjIE.application.Quit                   ‘关闭

TA的精华主题

TA的得分主题

发表于 2012-4-23 16:06 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2012-4-23 21:15 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2012-4-25 18:06 | 显示全部楼层
本帖最后由 goldowl2011 于 2012-4-25 18:09 编辑

经过学习示例代码,并结合实际情况终于实现了对弹出ie窗口的控制,并能够顺利取出其innerhtml,并进一步取得其框架内容,完成点击菜单及按钮的操作,并使用sendkeys完成对弹出的另存为窗口的控制,感谢弦月老师。现将代码段贴出,虽然简陋,但也可作为一个实例,以方便其他被此困扰的坛友们可以借鉴。再次感谢论坛提供了一个良好的交流空间和学习平台,真是受益良多,不胜言表!!!

模块内容:
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function SetForegroundWindow Lib "user32" (ByVal HWnd As Long) As Long
Declare Function ClientToScreen Lib "user32" (ByVal HWnd As Long, lpPoint As POINTAPI) As Long
Type POINTAPI
    x As Long
    y As Long
End Type

Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1

Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Const MOUSEEVENTF_MOVE = &H1 '  mouse move
Private Const MOUSEEVENTF_LEFTDOWN = &H2 '  left button down
Private Const MOUSEEVENTF_LEFTUP = &H4 '  left button up
Private Const MOUSEEVENTF_RIGHTDOWN = &H8 '  right button down


Private Const MOUSEEVENTF_RIGHTUP = &H10 '  right button up
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20 '  middle button down
Private Const MOUSEEVENTF_MIDDLEUP = &H40 '  middle button up
Private Const MOUSEEVENTF_ABSOLUTE = &H8000 '  absolute move

'============================================
Sub 客户信息查询()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim LinkX$, AccountNo$

Dim IE As Object
Dim file
Dim doc As Object  'MSHTML.HTMLDocument
Dim txt As String
Dim i&, j&, k&, H&, fgh$
Dim t1$, t2$, t3$, a, b, c, d
Dim webs, webs2, webs3, webs4, webs5, dmt, dmt1, dmt2, usrno
Dim strText$, Strtext1, Strtext2
Dim strname$, str, str1$, str1b$, str2$, str2b$, str3$, str4$, str5$, str6$, str7$, str8$, str9$, str12$, str13$, arr, arr1, arr2, arr3, arr4, arr5, Item&, URL, Url1&
Dim S0, S1, S2, S3, S4, S5, S6, S7, S8
Dim str10$, str11$, ShellApp As Object, SaveName$, ZipFolder$, TargetFile$
Dim v() As String, myjs, BRR
Dim cifno$, cifcname$, ResultLink$
Dim dj_x As Long, dj_y As Long, dj_num&, pdf_x As Long, pdf_y As Long
Dim dWinFolder As New ShellWindows, t
Dim objIE As Object, myHWND
Dim Czpmxurl As String, Czpmxname As String
Dim Czpmxhwnd As Long, aA        '窗口句柄

'删除IE的Cache缓存,非常重要!
Call DeleteCacheURLList

'--------------------------------------------------------------------------------------------------------MIS登录
'webs = ThisWorkbook.Sheets("Para1").Cells(221, 2).Value
Set IE = CreateObject("InternetExplorer.Application")

With ThisWorkbook.Sheets("Para1")  
    webs = .Cells(224, 2).Value & .Cells(222, 2).Value & .Cells(224, 4).Value & ChangeYZGPassword(.Cells(223, 2).Value) & .Cells(224, 6).Value & .Cells(224, 7).Value
    'Debug.Print webs
    usrno = .Cells(222, 2)   '登录用户号参数

IE.Navigate webs
IE.Visible = True     '若=0 False不显示 ,=1 True 显示  
IE.Silent = True

'Application.WindowState = xlMaximized   '窗体最大化

'----------------------------------------------------------------登录完成ok
Do While IE.Busy Or IE.ReadyState <> 4
    DoEvents
Loop

'网页执行效率太低只好多等一会儿:-(
Application.Wait now + TimeValue("00:00:10")

Set dmt = IE.Document
IE.Document.getElementById("condition").Value = .Cells(226, 3)   
IE.Document.getElementById("context").Focus
IE.Document.getElementById("context").Value = .Cells(227, 3)   
IE.Document.getElementById("context").Click

Application.Wait now + TimeValue("00:00:03")
IE.Document.getElementById("context").Focus
SendKeys "{enter}"
SendKeys "{enter}"    '回车开始查询

End With

Do While IE.Busy Or IE.ReadyState <> 4
    DoEvents
Loop

'---------------------------------------------------------
Application.Wait now + TimeValue("00:00:05")

'-------------------------------------------------------------查找弹出窗口并控制它以取出网页的innerhtml

    Do
        For Each objIE In dWinFolder
            If InStr(1, objIE.LocationURL, "customer.php?action=customerdetail&cifno=") > 0 Then
                Czpmxname = objIE.LocationName            '标题
                Czpmxurl = objIE.LocationURL              '链接
                Exit Do   '通过链接objIE.LocationURL包含的关键字查询,或用objIE.LocationName即窗口标题包含的关键字来查询
            End If
        Next
        DoEvents
    Loop
   
    '此处借用的老师提供链接示例中的代码,非常感谢!
    IE.Document.parentwindow.Eval "javascript:window.opener=null;window.open('','_self');window.close();"    '在原ie窗口中打开
    Set IE = objIE  '转换ie窗口控制权终于成功了
    Do Until IE.ReadyState = 4 And IE.Busy = False
        DoEvents
    Loop
    Set dmt = IE.Document
    'Debug.Print dmt.body.innerhtml
    '------------------------------------------------------------已成功取得弹出ie窗口页面innerhtml
   
     For i = 0 To dmt.Links.Length - 1
           If dmt.Links(i).innertext = "综合账单" Then  
              Debug.Print "Links(i) i=" & i
              dmt.Links(i).Click
              DoEvents
              Exit For
           End If
       Next
        
   Application.Wait now + TimeValue("00:00:05")
   
   
'Set obj1 = IE.Document.frames
'i = 0
'On Error GoTo showmsg:
'While 1
'strname = strname & Chr(10) & obj1.Item(i).Name
'i = i + 1
'Wend
'showmsg:
'Debug.Print "本网页中有 " & i & " 个框架:" & strname
'经测试共有2个框架,目标按钮"btn_ok1"在第2个框架内
'Debug.Print IE.Document.frames(0).Document.body.innerhtml
'Debug.Print IE.Document.frames(0).Location
'Debug.Print IE.Document.frames(1).Document.body.innerhtml
'Debug.Print IE.Document.frames(1).Location

If InStr(1, IE.Document.frames(1).Document.body.innerhtml, "Pdf对账单") > 0 Then
   'id=btn_ok1
   Debug.Print "已找到生成pdf对账单的按钮"
Else
    Exit Sub
End If

IE.Document.frames(1).Document.getElementById("btn_ok1").Click   '点击按钮下载文件

    t = Timer
    Do Until FindWindow(vbNullString, "文件下载") > 0
        DoEvents
    Loop
  
    Application.Wait now + TimeValue("00:00:03")
    SendKeys "^s"
    '------------------------------------------------------------------------------
    Do Until FindWindow(vbNullString, "另存为") > 0
        DoEvents
    Loop
    Application.Wait now + TimeValue("00:00:03")
    SaveName = ThisWorkbook.path & "\CheckYZG\" & "对账单_" & cifcname & "_" & Format(now(), "yyyymmddhhmmss") & ".pdf"
    SendKeys SaveName
    SendKeys "%s"
   

'======================================================================
'IE.Quit                   '关闭ie
'或:Shell ("C:\Program Files\Internet Explorer\IEXPLORE.exe about:blank")
ex:
    Application.Wait now + TimeValue("00:00:02")  '关闭弹出ie窗口
   
    Czpmxhwnd = FindWindow(vbNullString, Czpmxname & " - Windows Internet Explorer")       '根据窗口标题查找,找到后返回句柄
    If Czpmxhwnd <> 0 Then
        Debug.Print "已经找到指定弹出ie窗口并将关闭之"
        aA = SetForegroundWindow(Czpmxhwnd)    '将网页调到前台
        Application.Wait now + TimeValue("00:00:01") ''   程序休息
        SendKeys "%{F4}"
        'SendKeys "{ENTER}", True
    End If
   
   
   
    '退出原ie窗口
    IE.Quit
    Application.Wait now + TimeValue("00:00:02") ''   程序休息
    SendKeys "{ENTER}", True
   
    Shell ("C:\Program Files\Internet Explorer\IEXPLORE.exe about:blank")
   
    Set IE = Nothing
        
        
    '打开pdf下载文件目录
    'Application.Wait now + TimeValue("00:00:03")
    Shell "explorer.exe /n,/e," & ThisWorkbook.path & "\CheckYZG\", vbMaximizedFocus


    Application.ScreenUpdating = True
    Application.DisplayAlerts = True


End Sub

评分

参与人数 3鲜花 +7 收起 理由
veggieg + 2 优秀作品 very nice!! ^^
引子玄 + 2 优秀作品
xmyjk + 3 分享精神可嘉

查看全部评分

TA的精华主题

TA的得分主题

发表于 2012-7-22 10:00 | 显示全部楼层
在Dim dWinFolder As New ShellWindows处出现用户定义类型未定义的错误?

TA的精华主题

TA的得分主题

发表于 2012-7-22 15:23 | 显示全部楼层
出现错误截图
截图1342941437.png

点评

在工程中引用Microsoft Internet Controls对象  发表于 2013-3-25 19:45

TA的精华主题

TA的得分主题

发表于 2012-9-27 18:04 | 显示全部楼层
引子玄 发表于 2012-7-22 15:23
出现错误截图

请问老师:该问题应怎样解决?

TA的精华主题

TA的得分主题

发表于 2014-6-27 10:55 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2017-8-14 16:16 | 显示全部楼层
您好,我在您的网页自动化相关帖子里提到了MIS系统,因此猜测您是PA的同事,我最近也在开发同样的系统,是否方便加个好友一起讨论下?
我的微信:antonio547052212

补充内容 (2017-9-6 09:15):
打错字了,是我在您的帖子里看到您提到了MIS系统
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

最新热点上一条 /1 下一条

关注官方微信,每天学会一个新技能

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2019-10-23 02:39 , Processed in 0.138525 second(s), 16 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表