使用VBA自动填充网页表单

我正在尝试修复一个Excelmacros来自动填充一个Web窗体。 安全设置不允许表单被更快地操作，那么人们可以input信息。 我想包括一个计时器，以减慢过程每秒进入秒，但我不确定如何做到这一点。 下面是VBA：

Sub Load() On Error Resume Next ActiveWorkbook.VBProject.References.AddFromFile "C:\WINDOWS\system32\MSHTML.TLB" ActiveWorkbook.VBProject.References.AddFromFile "C:\WINDOWS\system32\ieframe.dll" Dim HTMLDoc As HTMLDocument Dim oBrowser As InternetExplorer Dim oHTML_Element As IHTMLElement Dim sURL As String Dim WPid As String Dim WPpercent As Double Dim Total As Double Dim WPname As String Dim dblClock As Double Dim Percent As Double On Error GoTo Err_Clear WPid = Range("A2") sURL = **** 'Set oBrowser = New InternetExplorer 'oBrowser.Silent = True 'oBrowser.timeout = 60 'oBrowser.navigate sURL 'oBrowser.Visible = True 'Do 'Wait till the Browser is loaded 'Loop Until oBrowser.readyState = READYSTATE_COMPLETE 'Reads out the object on the website 'For Each oHTML_Element In HTMLDoc.getElementsByTagName("input") 'Debug.Print oHTML_Element.Name 'Debug.Print oHTML_Element.Value 'Next Range("B2").Select Set oBrowser = New InternetExplorer 'oBrowser.Silent = True 'oBrowser.timeout = 60 oBrowser.navigate sURL oBrowser.Visible = True Do 'Wait till the Browser is loaded Loop Until oBrowser.readyState = READYSTATE_COMPLETE Set HTMLDoc = oBrowser.document Do While ActiveCell <> Empty And HTMLDoc.all.PrctRem.Value <> 0 WPpercent = Round(ActiveCell * 100, 2) Percent = HTMLDoc.all.PrctRem.Value If Percent = 0 Then Exit Do ActiveCell.Offset(0, 1).Select WPname = ActiveCell If WPpercent > Percent Then HTMLDoc.all.QBDPerct.Value = Percent Else HTMLDoc.all.QBDPerct.Value = WPpercent End If HTMLDoc.all.QBDLn.Value = WPname 'Do 'Loop Until HTMLDoc.all.QBDTot.Value = 100 - Percent And HTMLDoc.all.QBDPerct.Value = 0 ActiveCell.Offset(1, -1).Select 'Windows("QBD Load Tool").Visible = True 'MsgBox "Load next Event?" 'oBrowser.Quit 'oBrowser.Refresh HTMLDoc.all.Insert.Click Do While oBrowser.Busy Loop 'Do 'Wait till the Browser is loaded 'Loop Until oBrowser.readyState = READYSTATE_COMPLETE 'Set oBrowser = Nothing 'dblClock = Timer 'While Timer < dblClock + 1.3 'DoEvents 'Wend Loop oBrowser.Quit Set oBrowser = Empty Windows("QBD Load Tool").Activate MsgBox ("Load Complete. Check QBD and Save") Set oBrowser = New InternetExplorer oBrowser.Silent = True oBrowser.timeout = 60 oBrowser.navigate sURL oBrowser.Visible = True Err_Clear: If Err <> 0 Then Err.Clear Resume Next End If End Sub 

有什么build议么？

Answer 1

等待1秒钟：

 Application.Wait(Now + TimeValue("0:00:01")) 

Answer 2

试试这个脚本的顶部…它强制页面完全加载之前，你开始从中抓取数据。

 Do While ieApp.Busy: DoEvents: Loop Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop 

如果页面尚未加载，则无法从中获取数据。