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]

sorry no dice with the new version either. same errors coming up. its got to be something with my settings

Thanks for all your help though, i really appreciate you going out of your way to try and help.

 

[Anthony47]

I am sorry, but I have no other suggestion... Mybe just try replacing Sleep 100 with Sleep 800
What I used here is what I have been using since years, nothing special. It seems your computer is using some security that prevents interoperating between applications

It's a pity that no one else is partecipating to the discussion to exchange ideas

 

[mario92]

yea, thanks again for all your help. what your code did when it imported tables (on your other tab) is exactly what i want. Update, i just tried it on another (non work) computer and it ran fine. Ill have to talk to someone and try to figure out why it wont run on my work computer

 

[mario92]

Here is some code i tried to use off of the web. Its a different way to pull data and it works, i just need to line up what im pulling into the spreadsheet

#If VBA7 Then

Private Declare PtrSafe Function URLDownloadToFileA Lib "urlmon" Alias "URLDownloadToFile()" ( _
ByVal pcaller As LongPtr, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As LongPtr, _
ByVal lpfnCB As LongPtr) As LongPtr

#Else
Private Declare PtrSafe Function URLDownloadToFileA Lib "urlmon" Alias "URLDownloadToFileA()" ( _
ByVal pcaller As LongPtr, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As LongPtr, _
ByVal lpfnCB As LongPtr) As LongPtr
#End If


Sub Macro1()


Dim fileURL As String
Dim DestinationFile As String

fileURL = "https://www.newyorkfed.org/markets/data-hub.zip"
DestinationFile = "T:\Daily Downloads\wiseowl"

If URLDownloadToFileA(0, fileURL, DestinationFile, 0, 0) = 0 Then
Debug.Print "fiel download started"
Else
Debug.Print "file not started"
End If
End Sub

Sub LoadWebPage()

Dim XMLReq As New MSXML2.XMLHTTP
Dim VidPageURL As String

VidPageURL = "EASI Holdings - Amplify ETFs"

XMLReq.Open "GET", VidPageURL, False
XMLReq.Send

If XMLReq.Status <> 200 Then
MsgBox ("Problem" & vbNewLine & XMLReq.Status & "-" & XMLReq.statusText)
Exit Sub
End If


FindFileLink XMLReq.responseText

End Sub

Sub FindFileLink(HTMLText As String)


Dim HTMLDoc As New MSHTML.HTMLDocument
Dim Links As MSHTML.IHTMLElementCollection
Dim Link As MSHTML.IHTMLElement
Dim button As MSHTML.IHTMLElement

Set button = HTMLDoc.getElementsByClassName("button small")(0)

Set Links = HTMLDoc.getElementsByTagName("a") ' used to be ("a")

Debug.Print Links.Length


'div tags

For Each Link In Links
If Link.getAttribute("title") = "button small" Then
Exit For

Debug.Print Link.innerText, Link.getAttribute("a")
End If
Next Link

HTMLDoc.Body.innerHTML = HTMLText


End Sub

 

[mario92]

btw, where did you learn to webscrape like that. is it mostly trial and error or was there some outside info you use to find which tags you can pull off the internet. Its a huge skill to have and I would like to learn more. any help would be greatly appreciated

 

[mario92]

so ive been playing around with your code and noticed something as i stepped through the code (F8). I used a few on error resume nexts to keep coded going though. On the AactiveSheet.Paste at the bottom, when executed just cuts and pastes my vba editior sheet on the excel. when i just run it normally, nothing happens though

Sub ScreenShot()
Dim IE As Object
Dim myUrl As String
Range("A10").Select
On Error Resume Next
ActiveSheet.Pictures("ZCZCImg").Delete
On Error GoTo 0

'i added the below line
On Error Resume Next
If IE Is Nothing Then Set IE = CreateObject("InternetExplorer.Application")
myUrl = "Markets Data Dashboard - FEDERAL RESERVE BANK of NEW YORK"
With IE
.Visible = True '... rendi visibile IE
.Navigate myUrl '...vai all'url
Sleep 100
'Do While .Busy: DoEvents: Sleep (20): Loop 'Attesa not busy
'Do While .ReadyState <> 4: DoEvents: Sleep (20): Loop 'Attesa documento
End With
Application.SendKeys "(%{1068})"
On Error Resume Next
AppActivate "Microsoft Excel"
AppActivate "Excel"
On Error GoTo 0

Sleep 500

ActiveSheet.Paste

 

[Anthony47]

yea, thanks again for all your help. what your code did when it imported tables (on your other tab) is exactly what i want. Update, i just tried it on another (non work) computer and it ran fine. Ill have to talk to someone and try to figure out why it wont run on my work computer

Glad to know that the problem was not "my computer"!
Yes, if the target is a file then Function URLDownloadToFileA is a better approach
For what concerns Sub LoadWebPage, I have found that using the XMLReq don't guarantee that the full page be returned, given that today most of the web pages are dynamically composed using scripts. For example, my Sub GetWebTables a Do /Loop that "Wait for all Tables to assembled" that takes (in my pc) 1-2 seconds to complete. Also XMLReq doesn't allow you any comparison between what you see (on the page) and what you get.

These automations require that the source html code of the specific web page be inspected and you tailor the way to get the wanted information, using the properties and method offered by the MSHTML library. It include some try-and-error and, worstly, the solution has an unpredictable life. I mean that the source code of the web page sooner or later will be modified, and at that point you probably need to rearrange your code
The documentation for the mshtml library is not so generous as the documentation for vba..
For an overview on how IE internal components cooperate, see Internet Explorer Architecture (Internet Explorer)
For the mshtml, start from Internet Explorer Architecture (Internet Explorer)

Bye

 

[Anthony47]

So you discovered the Sub ScreenShot that I left in my Module1...

As I already sayd, you need to use the url not the description of the site
And if you use On Error Resume Next you will never know if the code performs ok or not: use On Error Resume Next only when you know that an instruction might generate an error; for example I use it before ActiveSheet.Pictures("ZCZCImg").Delete because I cannot be sure that the image is already or still on the worksheet.

That sub create a screenshot of the active window, IE in the context. It do work on my pc (my original one, with the url and without the extra OnError ResumeNext). If you download my GetWebPage.xlsm you will see on Sheet1 what it returns
For what I sayd in my previous message, the page is not completed when the IE status say "Not Busy" and IE.ReadyState get to "4" (it means "document completed") and you get some only blank tables; if you add Application.Wait (Now + TimeValue("0:00:04")) just before Application.SendKeys "(%{1068})" then you probably will also get the content of the first tables
However I guess that, if your pc has some strange security that prevents application interaction, then also the command Application.SendKeys "(%{1068})" will not be accepted and thus no any screenshot will be taken, i.e. nothing will be ready to be pasted to excel.

Bye

 

[mario92]

Hi Anthony,

I wanted to get back to you as i found out how to make ur code work. After searching the internet i came accross someone with same issue and they suggested this. Thought you would be interested

Controlling Internet Explorer local intranet using Excel VBA

I am using Excel VBA code to click a button on our website. I know this isn't the best of things to be doing, but it is the least objectionable option available to me. I can using this code,

stackoverflow.com

Here is a quick and easy solution for this issue:
Instead of:
set IE = createobject("internetexplorer.application")
Use:
Set IE = New InternetExplorerMedium
No need to tweak the IE settings
shareimprove this answer
edited Oct 7 '13 at 9:54

laalto
126k3030 gold badges229229 silver badges255255 bronze badges
answered Oct 7 '13 at 9:33

Vigneshts88
30633 silver badges22 bronze badges

• 7
  InternetExplorerMedium requires a reference to Microsoft Internet Controls – Mike Nov 3 '14 at 18:58

 

[Anthony47]

Good to know you was able to get to the solution...

I was sure that InternetExplorerMedium had some usefulness in dealing with old InternetExplorer versions, shall review it

Bye