假設說,我用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/m.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