2017-01-05 214 views
1

我想修復一個Excel宏以自動填充一個Web窗體。安全設置不允許表單被更快地操作,然後人們可以輸入信息。我想包括一個計時器,以減慢每次進入秒的過程,但我不確定如何做到這一點。下面是VBA:從VBA自動填充一個網頁表格從excel

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 

有什麼建議嗎?

回答

1

等待1秒:

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

試試這個對你的腳本的頂部...它迫使你的頁面開始從中獲取數據之前完全加載。

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

如果頁面尚未加載,則無法從中獲取數據。