ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 高效办公必会的Office实战技巧 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 6974|回复: 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 "use*****" 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 "use*****" (ByVal HWnd As Long) As Long
Declare Function ClientToScreen Lib "use*****" (ByVal HWnd As Long, lpPoint As POINTAPI) As Long
Type POINTAPI
    x As Long
    y As Long
End Type

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

Declare Sub mouse_event Lib "use*****" (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系统
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

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

GMT+8, 2019-8-24 01:33 , Processed in 0.110430 second(s), 16 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

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

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

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