显示Internet Explorer保存提示时出现错误91



我的目标是打开一个网站,输入表单,通过按钮保存报告,然后循环并继续下一个条目。我正在使用Microsoft WinHTTP、HTML对象库和Internet控件。

只要我没有";打开/另存为";Internet Explorer中的提示。它成功地循环显示结果并单击报告按钮,然后重新启动。然而,一旦出现提示,就导致行"中的中断;svalue1.Value=ws.Cells(最后一行,1(.Value";报告错误91,找不到对象,这是我一生都无法理解的。为什么保存提示会破坏VBA脚本?

注释掉了我尝试过的一些修复程序,但似乎没有什么能解决这个问题。我是不是错过了一些显而易见的东西?

谢谢你花时间帮助一个新手!:(

Enum READYSTATE
READYSTATE_UNINITIALIZED = 0
READYSTATE_LOADING = 1
READYSTATE_LOADED = 2
READYSTATE_INTERACTIVE = 3
READYSTATE_COMPLETE = 4
End Enum
Sub Test()
Dim ws As Worksheet: Set ws = Sheets("Sheet1") 'set the Sheet you are using here
Dim ie As New InternetExplorerMedium
'Set ie = New InternetExplorerMedium
Dim HTML As HTMLDocument
Dim i As Long
Lastrow = ws.Range("A1").End(xlDown).Row
'get the last row with a value in column A
strURL = "www.coollinkExample.com" 'set your initial URL here
ie.Visible = True
ie.navigate strURL
Do While (ie.Busy Or ie.READYSTATE <> READYSTATE.READYSTATE_COMPLETE)
DoEvents
Loop
Set HTML = ie.document
'-----------------INIT-----------------
'For i = 1 To Lastrow Step 1 'loop from row 1 to Last
Do While i < Lastrow 'loop from row 1 to Last
'Do While (ie.Busy Or ie.READYSTATE <> READYSTATE.READYSTATE_COMPLETE)
'DoEvents
'Loop BUGS WHEN SAVE PROMPT IS UP?
'-----------------BODY-----------------
'Do your data scraping here, then below go back to your initial URL to repeat the process
delay 5
Set svalue1 = HTML.getElementById("userNameText")
ie.document.getElementById("userNameText").Focus
svalue1.Value = ws.Cells(Lastrow, 1).Value 'enter the value from current cell
delay 2
ie.document.getElementById("btnSearchUser").Focus
HTML.getElementsByName("btnSearchUser").Item.Click
delay 3
ie.document.getElementById("rptUsers_ctl00_ddlUserOptions").Focus
HTML.getElementsByName("rptUsers_ctl00_ddlUserOptions").Item.Click
delay 3
ie.document.getElementById("rptUsers_ctl00_ddlUserOptions_lnkTranscript").Focus
HTML.getElementsByName("rptUsers_ctl00_ddlUserOptions_lnkTranscript").Item.Click
delay 3
ie.document.getElementById("__ta").Focus
HTML.getElementsByName("__ta").Item.Click
delay 2
ie.document.getElementById("__tj").Focus
HTML.getElementsByName("__tj").Item.Click
delay 4
With ie.document.getElementById("ctl00_ContentPlaceHolder1_btnExport")
.Focus
.Click
End With
delay 5
Application.SendKeys "%{S}"
delay 3
'-----------------END-----------------
ie.navigate strURL
delay 5
'Exit For
'Next i
i = i + 1
Loop
End Sub
'// This function below works fine.
Private Sub delay(seconds As Long)
Dim endTime As Date
endTime = DateAdd("s", seconds, Now())
Do While Now() < endTime
DoEvents
Loop
End Sub

循环结束时有ie.navigate strURL,但没有等待页面完全加载。

Option Explicit
Sub Test()
Dim ws As Worksheet
Dim ie As InternetExplorerMedium
Dim doc As HTMLDocument, strURL As String
Dim i As Long, lastrow As Long

strURL = "www.coollinkExample.com" 'set your initial URL here
Set ie = New InternetExplorerMedium
ie.Visible = True

Set ws = Sheets("Sheet1")
With ws
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To lastrow

' navigate to site
ie.navigate strURL
Do While ie.Busy Or ie.READYSTATE <> 4 'READYSTATE.READYSTATE_COMPLETE)
DoEvents
Loop
Set doc = ie.document
delay 5
doc.getElementById("userNameText").innerText = Trim(.Cells(i, "A"))
delay 3
doc.getElementById("btnSearchUser").Click
delay 3
doc.getElementById("rptUsers_ctl00_ddlUserOptions").Click
delay 3
doc.getElementById("rptUsers_ctl00_ddlUserOptions_lnkTranscript").Click
delay 3
doc.getElementById("__ta").Click
delay 3
doc.getElementById("__tj").Click
delay 3
doc.getElementById("ctl00_ContentPlaceHolder1_btnExport").Click
delay 5
Application.SendKeys "%(S)"
delay 3

Next i
End With
ie.Quit
MsgBox "Done", vbInformation

End Sub

最新更新