VBA- HTML -PDF download is corrupt issue

VBAPyro

New Member
Joined
May 4, 2020
Messages
5
Office Version
  1. 2019
Platform
  1. 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,
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

Forum statistics

Threads
1,223,164
Messages
6,170,439
Members
452,326
Latest member
johnshaji

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top