VBAPyro
New Member
- Joined
- May 4, 2020
- Messages
- 5
- Office Version
- 2019
- Platform
- Windows
I have code that will navigate to a website and do a search, select "view as PDF" and then download the pdf that is then attached to an outlook email. The issue I have is that every so often one of the pdf's is corrupt and cannot be opened. I found this happening a bit where the code would try to download the pdf before it was ready and cause this so I was forced to add an "application.wait" but this is still happening occasionally and I cannot seem to resolve it. Is there a way to ensure that the PDF is viewable before it is sent in an email and without opening it?
Here is my code:
Sub Invoicefind1()
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, Myfile(10) As String
Dim OLApp As Outlook.Application, olEmail As Outlook.MailItem
Dim OutAccount As Outlook.Account, ORecip As Object
Dim WHttp As Object, FileData() As Byte, filenum As Long
Dim x as Integer
''''additional code ''''
'click pdf
Set doc_eles = idoc.getElementsByTagName("img")
For Each doc_ele In doc_eles
If doc_ele.Title = "View as PDF" Then
doc_ele.Click
Exit For
End If
Next doc_ele
Do While I.Busy
Loop
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
FileData = WHttp.responseBody
Set WHttp = Nothing
Myfile(x) = "C:\Users\" & Trim(UserID) & "\Desktop\" & Sendinvoice.Controls("invnum" & x).Value & ".pdf"
filenum = FreeFile
On Error GoTo PathCheck
Open Myfile(x) For Binary Access Write As #filenum
On Error Resume Next
Put #filenum, 1, FileData
Close #filenum
Erase FileData()
''''additional code''''''
Exit Sub
Pause:
If M = 4 Then
MsgBox ("Error with pulling invoice " & Sendinvoice.Controls("invnum" & x).Value)
Exit Sub
End If
Application.Wait Now + #12:00:01 AM#
M = M + 1
Resume Save2
PathCheck:
If x = 1 Then
MsgBox ("please verify the following path is valid and try again, C:\Users\" & Trim(UserID) & "\Desktop\")
Exit Sub
Else
MsgBox ("Error with processing")
Exit Sub
End If
NotFound1:
MsgBox (Sendinvoice.Controls("invnum" & x).Value & " was not found, please review and try again")
Exit Sub
VPN1:
MsgBox ("Please make sure you are connected to the VPN and try again")
Exit Sub
End Sub
sometimes it will grab 4-5 pdf's but then the 6th one will be corrupt.
Thanks,
Here is my code:
Sub Invoicefind1()
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, Myfile(10) As String
Dim OLApp As Outlook.Application, olEmail As Outlook.MailItem
Dim OutAccount As Outlook.Account, ORecip As Object
Dim WHttp As Object, FileData() As Byte, filenum As Long
Dim x as Integer
''''additional code ''''
'click pdf
Set doc_eles = idoc.getElementsByTagName("img")
For Each doc_ele In doc_eles
If doc_ele.Title = "View as PDF" Then
doc_ele.Click
Exit For
End If
Next doc_ele
Do While I.Busy
Loop
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
FileData = WHttp.responseBody
Set WHttp = Nothing
Myfile(x) = "C:\Users\" & Trim(UserID) & "\Desktop\" & Sendinvoice.Controls("invnum" & x).Value & ".pdf"
filenum = FreeFile
On Error GoTo PathCheck
Open Myfile(x) For Binary Access Write As #filenum
On Error Resume Next
Put #filenum, 1, FileData
Close #filenum
Erase FileData()
''''additional code''''''
Exit Sub
Pause:
If M = 4 Then
MsgBox ("Error with pulling invoice " & Sendinvoice.Controls("invnum" & x).Value)
Exit Sub
End If
Application.Wait Now + #12:00:01 AM#
M = M + 1
Resume Save2
PathCheck:
If x = 1 Then
MsgBox ("please verify the following path is valid and try again, C:\Users\" & Trim(UserID) & "\Desktop\")
Exit Sub
Else
MsgBox ("Error with processing")
Exit Sub
End If
NotFound1:
MsgBox (Sendinvoice.Controls("invnum" & x).Value & " was not found, please review and try again")
Exit Sub
VPN1:
MsgBox ("Please make sure you are connected to the VPN and try again")
Exit Sub
End Sub
sometimes it will grab 4-5 pdf's but then the 6th one will be corrupt.
Thanks,