>我在VBA上有一个脚本，可以加载一个站点，复制数据并将其粘贴到隐藏页面上。它以前工作过，但我必须运行它大约 20 次才能让它做我想让它做的事情。错误非常不一致，我正在争论我是否应该继续这样做，因为我需要至少 95% 的成功率。
大多数情况下，数据未正确复制并且页面为空白，脚本完成时没有错误，但没有任何反应。
脚本失败的其他时间是在 Set ieTable = ieDoc.all.item -- Do While ieApp.Busy： DoEvents： Loop -- Set ieDoc = ieApp.Document
如您所见，为了能够检查错误发生的位置，我已经用消息提示困扰了所有内容。
Sub Pull_Data()
'Kills ALL IE windows
On Error GoTo Ignore:
Call IE_Sledgehammer
Ignore:
Dim ieApp As InternetExplorer
Dim ieDoc As Object
Dim ieTable As Object
Dim clip As DataObject
Dim UserName As String, Password As String
Dim SubmitButton
Dim i As Integer
'Create anew instance of ie
Set ieApp = New InternetExplorer
ieApp.Navigate "Intranet site I cannot share"
'Debugging
ieApp.Visible = True
'When busy - wait
On Error GoTo Skip_wait
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
GoTo Login
'Debugging
Skip_wait:
MsgBox ("You skipped the first wait")
Login:
'*****common error*****
Set ieDoc = ieApp.Document
Set SubmitButton = ieDoc.getElementsByTagName("input")
'Login script
With ieDoc.forms(0)
If Err.Number = 424 Then
GoTo skip_login
.UserName.Value = "USERNAME"
.Password.Value = "PASSWORD"
SubmitButton(i).Click
End If
End With
GoTo wait
'Debugging
skip_login:
MsgBox ("You skipped the login")
'When busy - wait
wait:
On Error GoTo Skip_waiting
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
GoTo Copypaste
Skip_waiting:
MsgBox ("You skipped the second wait")
'Copy&paste script
Copypaste:
Set clip = New DataObject
Set ieTable = ieDoc.all.item
clip.SetText "" & ieTable.outerHTML & ""
clip.PutInClipboard
Sheets("Raw Data").Range("E2").PasteSpecial "Unicode Text"
'Kills all activeX/controls copied from ieDoc.all.item
Sheets("Raw Data").DrawingObjects.Delete
'Kills ALL IE windows
On Error GoTo Ignored:
Call IE_Sledgehammer
Ignored:
End Sub
我确实知道从网络选项中提取数据，这是我在这件事上的首选，但由于我们的办公室已经更改了其安全设置，因此该选项变得不可能。除此之外，我想不出一种通过单击按钮提取数据的方法。
这个选项值得吗？对于任何有经验的人，你能告诉我这个选项是否可靠吗？我一辈子都无法弄清楚为什么这会失败。
.HTML：
<html><head>
<title>
Open Questions Summary
</title>
<link rel="stylesheet" href="/styles.css" type="text/css">
</head>
<body bgcolor="#FFFFFF">
<table cellspacing="1" cellpadding="2" align="center" border="0" width="400">
<tbody><tr>
<td colspan="2">
Customer Sector:
<form method="get" action="INTERNAL WORK SITE">
<select name="strCustomerType">
<option value="residential" selected="selected">Residential</option>
<option value="business">Business</option>
</select>
<input name="soobmit" value="Submit" type="submit">
</form></table>
从您的代码和描述来看，您似乎想在文本框中填充值并处理下拉列表，我建议您参考以下代码，它们在我的机器上都运行良好：
Sub LoginViaBrowser()
Dim IE As Object
Dim Dc_Usuario As String
Dim Dc_Senha As String
Dim Dc_URL As String
Dim txtNam As Object, txtPwd As Object
Dc_Usuario = "user@email.com"
Dc_Senha = "pass"
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True
.Navigate "https://www.solarmanpv.com/portal/LoginPage.aspx"
While IE.ReadyState <> 4
DoEvents
Wend
IE.Document.getElementById("uNam").Value = Dc_Usuario
IE.Document.getElementById("uPwd").Value = Dc_Senha
IE.Document.getElementById("Loginning").Click
End With
Set IE = Nothing
End Sub
句柄下拉列表：
Public Sub ClickTest()
Dim ie As Object, evtChange As Object
Dim item As Object
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
.Navigate2 "<the website url>"
While .Busy Or .readyState <> 4: DoEvents: Wend
Set evtChange = .Document.createEvent("HTMLEvents")
evtChange.initEvent "change", True, False
'get the select element. Please note the index, it is starting from 0.
Set item = ie.Document.getElementsByTagName("select")(0)
expCcy = "EUR"
'Set the Expression Currency
For Each o In item 'Sets Expression Currency
If o.Value = expCcy Then
o.Selected = True
o.dispatchEvent evtChange
Exit For
End If
Next
End With
End Sub
更多详细信息，请检查以下线程：文本框相关线程和下拉列表相关线程。