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
有什麼建議嗎?