单击 Img 标记时出现 VBA HTML 脚本错误



我在VBA中有一个脚本,可以导航到IE中的几个页面。我大约有 100 人使用此脚本没有任何问题,但是每次都有 1 人在同一位置出现错误。 这个按钮和其他按钮之间的唯一区别是它是一个img而不是一个按钮 我无法弄清楚问题,请帮忙!当脚本到达此位置时,它确实会找到"以 PDF 格式查看"并单击它,但是 PDF 未加载。

Sub Invoicepull()
Dim I As SHDocVw.InternetExplorer, idoc As MSHTML.HTMLDocument
Dim doc_ele As MSHTML.IHTMLElement, doc_eles As MSHTML.IHTMLElementCollection, doc_click As MSHTML.IHTMLElement, doc_clicks As MSHTML.IHTMLElementCollection
Dim doc_ele2 As MSHTML.IHTMLElement, doc_eles2 As MSHTML.IHTMLElementCollection
Dim UserID As String, MyURL As String
Dim WHttp As Object, FileData() As Byte, filenum As Long
Dim Store_ele As MSHTML.IHTMLElement, BPN As String
Dim x As Integer, Y As Integer, Invoices As String
Dim M As Integer, MyFile As String
Dim XX As Double, Cycle As Integer

'i.Visible = True 'for testing only
UserID = Range("k1").Value
Set I = New InternetExplorerMedium
Found1 = False
BPN = ""
I.Navigate "http://pbi_e1_vault.pb.com/ServiceWeb2/Interface"
Do While I.ReadyState <> READYSTATE_COMPLETE
Loop
Set idoc = I.Document
On Error GoTo VPN1
If Range("m1").Value = "US" Then
If Left(MDI.txtinv.Value, 1) = 3 Then
idoc.getElementsByTagName("Select").Item("DB").Value = "uslease"
Else
idoc.getElementsByTagName("Select").Item("DB").Value = "usnonlease"
End If
ElseIf Range("m1").Value = "CA" Then
If Left(MDI.txtinv.Value, 1) = 3 Then
idoc.getElementsByTagName("Select").Item("DB").Value = "calease"
Else
idoc.getElementsByTagName("Select").Item("DB").Value = "canonlease"
End If
End If
On Error GoTo 0
Set doc_eles = idoc.getElementsByTagName("input")
For Each doc_ele In doc_eles
If doc_ele.Title = "Search" Then
doc_ele.Click
Exit For
End If
Next doc_ele
Do While I.Busy
Loop
idoc.getElementsByTagName("Select").Item("K").Value = "InvoiceNumber"
idoc.getElementsByTagName("Input").Item("Q").Value = MDI.txtinv.Value
Set doc_eles = idoc.getElementsByTagName("input")
For Each doc_ele In doc_eles
If doc_ele.Title = "Search" Then
doc_ele.Click
Exit For
End If
Next doc_ele
Do While I.Busy
Loop
'search for inv
Set doc_eles = idoc.getElementsByTagName("a")
For Each doc_ele In doc_eles
If doc_ele.innerText = MDI.txtinv.Value Then
If Found1 = False Then
Found1 = True
Set Store_ele = doc_ele
Else
'found a duplicate invoice request bpn
BPN = InputBox("More than one invoice found, please enter 
the BPN for invoice " & MDI.txtinv.Value, "Multiple invoices", 
"0012345678")
TryAgain:
Set doc_eles2 = idoc.getElementsByTagName("a")
For Each doc_ele2 In doc_eles2
If doc_ele.innerText = BPN Then
doc_ele.Click
Exit For
End If
Next doc_ele2
If doc_ele.innerText <> BPN Then
BPN = InputBox("BPN was not found, please make sure to 
include 00 before the number", "Not found", "0012345678")
GoTo TryAgain
End If
End If
If BPN <> "" Then
Exit For
Else
Store_ele.Click
Exit For
End If
End If
Next doc_ele
If doc_ele Is Nothing Then GoTo NotFound1
Do While I.Busy
Loop
'click pdf
Set doc_eles = idoc.getElementsByTagName("img")
For Each doc_ele In doc_eles
'If doc_ele.getAttribute("src") = "images/csearch.gif" Then
If doc_ele.Title = "View as PDF" Then
''Error is here''' Clicks Doc_ele but does not actually load pdf''' 
doc_ele.Click
Exit For
End If
Next doc_ele
'Application.Wait Now + #12:00:03 AM#
'save PDF
Save2:
MyURL = I.LocationURL
Set WHttp = CreateObject("WinHTTP.WinHTTPrequest.5.1")
WHttp.Open "GET", MyURL, False
On Error GoTo Pause
WHttp.send
On Error GoTo 0
XX = InStr(1, WHttp.responseText, "/Title")
If XX = 0 Then
Application.Wait Now + #12:00:01 AM#
Cycle = Cycle + 1
If Cycle = 9 Then GoTo NotFound1
GoTo Save2
End If
Cycle = 0
FileData = WHttp.responseBody
Set WHttp = Nothing
If Worksheets("Tracking").Range("b15").Value = "" Then
MyFile = "C:Users" & Trim(UserID) & "Desktop" & MDI.txtinv.Value & 
".pdf"
Else
MyFile = Worksheets("Tracking").Range("b15").Value & "" & 
MDI.txtinv.Value & ".pdf"
End If
filenum = FreeFile
On Error GoTo PathCheck
Open MyFile For Binary Access Write As #filenum
On Error GoTo 0
Put #filenum, 1, FileData
Close #filenum
Erase FileData()
I.Quit 'close IE
'add invoice to list and track
If Range("a2").Value = "" Then
Range("a2").Value = MDI.txtinv.Value
Range("b2").Value = "Pulled"
Range("c2").Value = MDI.lblpath.Caption
Range("f2").Value = Format(Now, "MM/DD/YYYY")
Else
Range("a1").End(xlDown).Offset(1).Value = MDI.txtinv.Value
Range("b1").End(xlDown).Offset(1).Value = "Pulled"
Range("a1").End(xlDown).Offset(, 2).Value = MDI.lblpath.Caption
Range("a1").End(xlDown).Offset(, 5).Value = Format(Now, "MM/DD/YYYY")
End If
Worksheets("Tracking").Range("A1").Value = 
Worksheets("Tracking").Range("A1").Value + 1
If Worksheets("Tracking").Range("A1").Value >= 40 Then 
Call SendInv.SendUpdate
ThisWorkbook.FollowHyperlink (MyFile) 'open PDF
Exit Sub

尝试使用 execScript 方法来执行 JavaScript 脚本并单击按钮。

Call IE.document.parentWindow.execScript("document.querySelector('img[title=""View as PDF""]').click();", "JavaScript")

最新更新