假设说,我用vba近入了某网页 网页上面的资料需要输入日期查寻 我将日期都填入後 找出type="submit" 开始搜索资料 接着本该是资料会先列出来 然後 excelWB 17,0 excelWB 12,2 会将网页上的所有资料给copy出来 (一般网页教学大致上是这样) 但很奇怪的是 . 顺序却变成 在资料还在搜寻没完成时 就全选拷贝了 . 最终贴上工作表的资料只有一开始还没搜寻的时候 . . 而我做了一个测试 我在 MyBrowser.ExecWB 17, 0 'Select All 这行 放了一个中断点暂停一下 . 然後继续跑 资料就正常的出现搜寻後的资料了 求高手指点 . . . . (以上登入IE帐密跟设定网页部份恕删) Set MyBrowser = New InternetExplorer MyBrowser.Silent = True MyBrowser.navigate MyURL MyBrowser.Visible = True Do Loop Until MyBrowser.readyState = READYSTATE_COMPLETE Set HTMLDoc = MyBrowser.document HTMLDoc.all.Email.Value = 帐号 'Enter your email id here HTMLDoc.all.passwd.Value = 密码 'Enter your password here For Each MyHTML_Element In HTMLDoc.getElementsByTagName("input") If MyHTML_Element.Type = "submit" Then MyHTML_Element.Click: Exit For End If Next Do While MyBrowser.readyState = 4 '等待网页开启 DoEvents Loop MyBrowser.navigate MyURL MyBrowser.Visible = True Do Loop Until MyBrowser.readyState = READYSTATE_COMPLETE Set HTMLDoc = MyBrowser.document Set HTMLDoc = MyBrowser.document HTMLDoc.all.txtsdate.Value = 开始日期 HTMLDoc.all.txtedate.Value = 结束日期 For Each MyHTML_Element In HTMLDoc.getElementsByTagName("input") If MyHTML_Element.Type = "submit" Then MyHTML_Element.Click: Exit For End If Next Do While MyBrowser.readyState = 4 '等待网页开启 DoEvents Loop '------------------------------------------------ MyBrowser.ExecWB 17, 0 'Select All MyBrowser.ExecWB 12, 2 'Copy selection '------------------------------------------------ Sheets("网页资料自动汇入用").Select Cells.Select ActiveSheet.PasteSpecial Format:="HTML", link:=False, DisplayAsIcon:= _ False, NoHTMLFormatting:=True MyBrowser.Quit --

※ 发信站: 批踢踢实业坊(ptt.cc), 来自: 114.35.158.244 ※ 文章网址: https://webptt.com/cn.aspx?n=bbs/Office/M.1482541341.A.71B.html ※ 编辑: waiter337 (114.35.158.244), 12/24/2016 09:06:13 Do While MyBrowser.Busy Or _ MyBrowser.readyState <> 4 DoEvents Loop Do Loop Until MyBrowser.readyState = READYSTATE_COMPLETE ※ 编辑: waiter337 (114.35.158.244), 12/24/2016 10:28:28 另外请教一下 如果有跳出js的alert视窗 按下确定 空白 或esc 就可以跳离 我试了很多方法 但没办法成功的选取警告视窗 是该js网页本身的alert 我用sendkey 的alt+tab两下想回头选 但用巨集还是会卡住 目前尝试过这些 但无解 该网页我用 Set MyBrowser = New InternetExplorer '--------------以下为死马当活马医到处乱塞的巨集 MyBrowser.Silent = True Application.SendKeys ("%{TAB}") DoEvents Application.SendKeys ("%{TAB}") DoEvents Application.SendKeys ("enter") Application.SendKeys ("ESC") DoEvents HTMLDoc.Click 但没有一个成功 求S大解惑一下 ※ 编辑: waiter337 (1.175.32.129), 12/24/2016 15:20:40 还有这些 ' lngHwnd = FindWindow(vbNullString, "Windows Internet Explorer") ' lngParent = GetParent(lngHwnd) ' If lngHwnd > 0 And lngParent = lngFrmHwnd Then ' SetForegroundWindow lngHwnd ' SendKeys "~" ' ' lngHwnd = 0　'<----- 拿掉这个看看. ' End If ' pDisp.document.parentWindow.execScript "window.alert=null;" ' pDisp.document.parentWindow.execScript "window.confirm=null;" ' pDisp.document.parentWindow.execScript "window.showModalDialog=null;" ' pDisp.document.parentWindow.execScript "window.open=null;" ※ 编辑: waiter337 (1.175.32.129), 12/24/2016 15:21:10 但我也在怀疑 是不是警告视窗跳的速度比较慢 所以这些按键其实 是被先用掉了 ※ 编辑: waiter337 (1.175.32.129), 12/24/2016 15:22:43 Do While MyBrowser.busy Or _ MyBrowser.readyState <> 4 ' DoEvents MyBrowser.Silent = True ' MyHTML_Element.Select ' MyHTML_Element.Click ' MyBrowser.Select ' MyBrowser.Click Application.SendKeys ("%{TAB}") DoEvents Application.SendKeys ("%{TAB}") DoEvents ' Application.SendKeys ("enter") Application.SendKeys ("ESC") ' DoEvents ' HTMLDoc.Click ' MyHTML_Element.Select ' MyHTML_Element.Click ' MyBrowser.Select ' MyBrowser.Click Loop Do Loop Until MyBrowser.readyState = READYSTATE_COMPLETE ' SendKeys "~" 目前状况 我被我公司的伺服器给锁了(要等30分钟才会解开) 刚刚按下去按钮 我崩溃了 一秒钟连续登入错误四次,刚大概连续登入上百次了.... 然後就GG 但不知道是不是有稍微成功了 目前没被我注掉的 可能就有机会 因为好像跟我想的一样 我在警告还没跳出来之前就已经sendkey了 所以要在警告跳出来的回圈内sendkey可能才有效果 但如果sendkey enter或"~"空白键 就太危险了 所以半个小时後我试试看esc ※ 编辑: waiter337 (1.175.32.129), 12/24/2016 15:46:01 这篇我有注意到 不过我还没办法领悟这篇的关键 看似好像要跳到api设定 不过目前问题还是没找到施力点 ※ 编辑: waiter337 (114.35.158.244), 12/25/2016 03:45:48