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

 

[Anthony47]

Your ActiveWorkbook.FollowHyperlink do not open any workbook, so you will export the initial sheet, nothing more.

Why don't you just insert that picture in your worksheet, using Menu /Insert /Image; then rather than inserting the name on your local disc insert the https address. Or, using vba:

    Range("A10").Select
    On Error Resume Next
        ActiveSheet.Pictures("WTICRUDE").Delete
    On Error GoTo 0
    ActiveSheet.Pictures.Insert( _
        "https://www.dallasfed.org/research/surveys/des/2019/~/media/Images/research/surveys/des/2019/1904/des1904forecast1.png" _
        ).Select
    Selection.ShapeRange.Name = "WTICRUDE"
    Range("A10").Select[code]

The inserted picture is indeed "linked" to the web site; thus "tomorrow" you should see a different graph. But you can rerun the Pictures.Insert macro, and the old picture will be removed and a new one will be reinserted.

At this point you can print the worksheet using "Microsoft Print to PDF" as the activeprinter and you shall get the pdf file.

For the printing, I suggest that you record a macro while execute manually a printout; in this phase you will specify, for example, the landscape format and "Scale on one page". Eventually you need to replace, in the long long code that you get, the listed ActiveWindow.SelectedSheets.PrintOut etc etc command with this new one:
[code]    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False, PrToFileName:="C:\YourPath\YourFileName.pdf", ActivePrinter:="Microsoft Print to PDF"

Adapt the PrToFileName parameter to your choice.

HTH
Bye

 

[mario92]

Hi HTH,

Thanks for your help, i really appreciate it. It always amazes me how big problems for some (me) are so easily solved by others

One question, does the below line of code just delete former instances of wti pic so a new one can replace it?
ActiveSheet.Pictures("WTICRUDE").Delete

 

[Anthony47]

Yes, that instruction delete the previous image, if there is one (that is why I use OnError Resume Next); then I insert the (new) image and assign it a known name.
Bye

 

[mario92]

Hi Anthony,

One quick follow up if you would be so kind. I've been trying to modify your code to just save a website (such as www.newyorkfed.org/markets/data-hub ). It seems like i can not just save the image, can i just save the whole page (basically like pressing Cntrl P and save as a pdf

 

[Anthony47]

This is something completely different, and needs to be solved in a completely different way…
But first you should clarify what you need from the site: The pictures, the Text, or the Datas, or "All"?

Supposing that you need (given the type of webpage) the "Datas", then the following macro will import from the web page all the available tabular data:

 '   >>> 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("ImportedTables")                         '<<< The worksheet to be used for the imported data
myUrl = "https://www.newyorkfed.org/markets/data-hub"       '<<< The URL
'
If IE Is Nothing Then 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

This code need to be copied to an EMPTY standard vba module, so that the Declare is on top; the instructions marked <<< need to be adapted to your situation.
When you are ready then just run Sub GetWebTables; it will CLEAR the worksheet you specified to be used for the data import, then open IE at the specified Url, import the available "tables", close IE.

As I sayd, this is my interpretation of your question…

Bye

 

[mario92]

Hi Anthony,

Thanks for the reply

I keep getting run time error 462 "the remote server machine does not exist or is unavailable on a few lines below. I have tried this method b/f and always end up with this error and I'm not sure how to debug it or why i get it


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")

any thoughts?

 

[Anthony47]

Do you see an InternetExplorer session that is open by the macro? Which line is in error? Did you Copy the code and Pasted it into your vba module, or did you retype it?

 

[mario92]

Yes, the macro opened the right website.
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")

i did copy and paste but changed imported tables to "Sheet1" to match my excel
Set IESh = Sheets("ImportedTables")

 

[Anthony47]

You mean that you get the error at random on one of those lines? Did the macro ever completed without error? Did it ever imported anything?
Which Excel version are you using, on which Operating System

Try replacing If IE Is Nothing Then Set IE = CreateObject("InternetExplorer.Application") with

Set IE = CreateObject("InternetExplorer.Application")

Maybe it will throw a different error.

Anyway the answer to all the above questions are useful

Bye