Trying to open webpage and save it as a pdf

[mario92]

I was wondering if anyone could help. I want to open a website and save the image that opens as a pdf. My code is below and when i save it to a pdf w/ current code, nothing shows up in the pdf file that is save. Its as if the file is corrupted or something. Anyone have any thoughts?


Sub CallWebPage()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False

Dim newdate As Date
Dim StartTime As Date
Dim MinutesElapsed As Double
StartTime = Now()

Call makefolder(newdate)

Dim OpenPlace As String
Dim SavePlaceAlt As String
SavePlace = "T:\Daily Downloads\Fed Reserve\" & Format(newdate, "mm-dd-yyyy") & "\"
OpenPlace = "T:\Daily Downloads\Fed Reserve\" & Format(newdate, "mm-dd-yyyy") & "\"

Dim ManEmp As String
Dim Mort_30_yr As String

Oil_Price_Forcast = "https://www.dallasfed.org/research/...ch/surveys/des/2019/1904/des1904forecast1.png"



ActiveWorkbook.FollowHyperlink _
Address:=Oil_Price_Forcast, _
NewWindow:=True, _
AddHistory:=True
Application.WindowState = xlNormal


ActiveWorkbook.SaveAs filename:=SavePlace & "Oil Price Forcast " & Format(newdate, "mm-dd-yyyy") & ".pdf" ' , FileFormat:=51
ActiveWorkbook.Close




End Sub




Sub makefolder(newdate)

Dim filename As String
Dim zfilename As String


If Weekday(Now(), vbMonday) = 1 Then
newdate = Now() - 3
Else
newdate = Now() - 1
End If

filename = "T:\Daily Downloads\Fed Reserve\" & Format(newdate, "mm-dd-yyyy")
zfilename = Dir(filename, vbDirectory)

If zfilename = "" Then
MkDir ("T:\Daily Downloads\Fed Reserve\") & Format(newdate, "mm-dd-yyyy")

Else
Exit Sub
End If

End Sub

 

[mario92]

Hi Anthony,

to answer your questions
The macro never completely ran though with the previous version
it never imported anything onto excel
im using excel 2016 and windows 10

after making your suggested change i still get the same errors. Just a hunch as i inspected the webpage, im not sure there are tables to grab and maybe why the code below cant pull anything
Set aColl = IE.document.getElementsByTagName("TABLE")

 

[Anthony47]

These are the lines that gave me that error (below)
Do While .Busy: DoEvents: Sleep (20): Loop 'Attesa not busy
Do While .ReadyState <> 4: DoEvents: Sleep (20): Loop 'Attesa document
Set aColl = IE.document.getElementsByTagName("TABLE")

You wrote there were 3 lines that create an error; is that wrong? Which line/lines generate an error?

Why don't you test it using the same Url that you yoursel listed?

No, if there are no Tables on the webpage the macro will not generate an error, just will say "0 Tables imported"; which Url did you try?

 

[mario92]

the same 3 lines are still giving me an error, i just commented the 2 do whiles out to to keep the code going. I did test it w/ my url same issue

 

[Anthony47]

Please share your workbook containing the macro, the one that fails

Upload it to a fileserver, like dropbox.com or filedropper.com, then share the download link.

Bye

 

[mario92]

the below is what im using, does this code run on your computer?

' >>> STRICTLY ON TOP OF A STANDARD VBA MODULE <<<

#If VBA7 Then
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Sub GetWebTables()
Dim IE As Object, IESh As Worksheet, FlEx As Boolean, myTim As Single
Dim i As Long, KK As Long, aColl As Object, myUrl As String, OCLen As Long
Dim myItm As Object, tRtR As Object, TdTd As Object, J As Long

'BEWARE that the Sheet you are going to specify will be CLEARED at the beginning
Set IESh = Sheets("Sheet1") '<<< The worksheet to be used for the imported data
myUrl = "Markets Data Dashboard - FEDERAL RESERVE BANK of NEW YORK" '<<< The URL
'
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True '...
.Navigate myUrl '...
Sleep 100
Do While .Busy: DoEvents: Sleep (20): Loop 'Attesa not busy
Do While .ReadyState <> 4: DoEvents: Sleep (20): Loop 'Attesa document
End With
'
i = 0: KK = 1
IESh.Range("A:Z").ClearContents
IESh.Range("A:Z").NumberFormat = "@"
myTim = Timer
'Wait for all Tables to assemple
Do
Set aColl = IE.document.getElementsByTagName("TABLE")
If aColl.Length > OCLen Then
OCLen = aColl.Length
FlEx = False
myTim = Timer
Else
If FlEx And aColl.Length > 0 Then Exit Do 'Tables stable
FlEx = True
End If
Debug.Print aColl.Length, Timer - myTim
If Timer > (myTim + 5) Or Timer < myTim Then Exit Do 'or Timeout
Sleep 500
DoEvents
Loop
For Each myItm In aColl
' If ... Then 'Spare
IESh.Cells(i + 1, "A").Value = "TABLE#_" & KK: KK = KK + 1: i = i + 1
For Each tRtR In myItm.Rows
For Each TdTd In tRtR.Cells
IESh.Cells(i + 1, J + 1) = TdTd.innerText
J = J + 1
Next TdTd
i = i + 1: J = 0
Next tRtR
' End If
i = i + 1
Next myItm
'
On Error Resume Next
IE.Quit
Set IE = Nothing
MsgBox (KK - 1 & " Tables have been imported")
End Sub

 

[Anthony47]

You set myUrl = "Markets Data Dashboard - FEDERAL RESERVE BANK of NEW YORK" '<<< The URL; but this is the "description" of the site not the Url (Uniform Resource Locator).

But even with this inconsistency, my Internet Explorer (IE 11) opens the search page and shows me some results; there are no "Tables" in this result, and the macro after 5 seconds will return the message "0 Tables have been imported", then IE is closed and the macro terminates flawless.

If I replace the site description with the site url ("Markets Data Dashboard - FEDERAL RESERVE BANK of NEW YORK") then 28 table will be imported (this number can change as the site can show different datas at different moments)

You can download MY TEST FILE here: GetWebPage.xlsm
Two buttons in "Foglio1" start either Sub GetWebTables in Module1 (the macro with the url of the site) or Sub GetWebTables222 in Module2 (the same macro with the description of the site)

Even changing the url I was not able to simulate any error.

Try by yourself using my test file and let me know.

If you still have problem, then close InternetExplorer and your other browsers; start your Windows Task Manager. Check underr the "Processes" tab if you have any "InternetExplorer" process open; if Yes then kill these processes and retry the macro.

Bye

 

[mario92]

i went to your test file and get the same errors as b/f, i guessing its something to do w/ my computer settings. Just a thought, do you have any other reference libraries checked? would that interfere with my code?

 

[Anthony47]

No any external library needs to be enabled (technically, the code works in "late binding").
My best guess is that you don't have Internet Explorer available in your computer; when you run the macro, does an Internet Explorer window open (not any other browser)? You can better test for this if you add a STOP in the following position:

    .Navigate myUrl         '...
STOP
    Sleep 100

NB: maybe you downloaded not the final version of my test file (I realized just now that the file was still open in my Pc and still to be Saved)

Bye

 

[mario92]

No, i have IE on my computer and when i put in stop (where u suggested) the webpage opened and was visable. I just tried it again and same issues

 

[Anthony47]

Ok, I have no idea

I have created a new version of my test file, with a third button that "anchors" keywords to their parent; download and check it...

Also I have prepared a new test file, that uses "early binding" and thus have (already) set references to additional vba libraries (mshtml and Internet Controls); this file is avalable here: GetWebPage_EB.xlsm
Download and test it too

Waiting for your and anybodyelse feedback
Bye