Sona Shetty
Sona Shetty

Reputation: 1047

How to download a pdf file from browser using Excel VBA

I am using the below code snippet to download a PDF file from a website.

Option Explicit

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

Sub Test()
    Dim strPDFLink As String
    Dim strPDFFile As String
    Dim Result As Boolean
    strPDFLink = "myurl?SessionKey=rCpZeX9UP300002D50BA&  docid=*8G0leLEfTTX3oX8QpVUmKqRoTj6zS6bzTWf9%29Dt1hij3ym9hKqucLhtOnWVeCgM0wyGJyjI9RNj3Kv&PageNo=1"
    strPDFFile = "D:\Users\d828737\Desktop\Doc Comparison\Temp\abcd.pdf"
    Result = DownloadFile(strPDFLink, strPDFFile)
End Sub

Function DownloadFile(URL As String, LocalFilename As String) As   Boolean
    Dim lngRetVal As Long
    lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
    If lngRetVal = 0 Then DownloadFile = True
End Function

Below is the response I am getting from browser using code

<html>
  <head>
  <META http-equiv="Content-Type" content="text/html; charset=UTF-8">
  <title>Interview Enterprise Web Client</title>
  </head>
  <frameset name="ImageFrame" border="1" framespacing="0" topmargin="0"   leftmargin="0" marginheight="0" marginwidth="0" rows="*,80">
  <frame name="document" src="iv_web_client.iv_document?SessionKey=1aYT4sGK1200002D50C6&amp;docid=*8G0SU4Fcf)xcWWX6e96)FGlOL4rOYYt0i3m)HlGth2F(W4RnxurPClkHvNBurOAsaeNfGlwBKzzTm5&amp;outputname=&amp;FirstPage=1&amp;options=" scrolling="auto" border="0" frameborder="no" topmargin="0" leftmargin="0" marginheight="0" marginwidth="0" style="border-bottom:solid#000000 1px;" noresize="">
  <frame name="control" src="iv_web_client.iv_doc_sel?SessionKey=1aYT4sGK1200002D50C6&amp;docid=*8G0SU4Fcf)xcWWX6e96)FGlOL4rOYYt0i3m)HlGth2F(W4RnxurPClkHvNBurOAsaeNfGlwBKzzTm5&amp;outputname=&amp;pageno=1&amp;options=" scrolling="auto" border="0" frameborder="no" topmargin="0" leftmargin="0" marginheight="0" marginwidth="0" style="border-bottom:solid#000000 1px;" noresize="">
  </frameset>
  <noframes>You need a frames capable browser to use this site.</noframes>
</html>

I have also tried the below method

Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")
WHTTP.Open "GET", fileUrl, False
WHTTP.Send
FileData = WHTTP.ResponseBody

When I open the url given in the above code in browser, I can see pdf file getting opened automatically. How do I download the same pdf file opened in my browser using code?

Can some one help me to resolve the issue.

Upvotes: 4

Views: 14070

Answers (1)

ASH
ASH

Reputation: 20302

I can think of a couple ways to do this. If you want to loop through a bunch of links, and download all files, you can setup an inventory list in Excel, like you see in the image below.

enter image description here

Then, run the following Macro.

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

Sub DownloadFilefromWeb()
    Dim strSavePath As String
    Dim URL As String, ext As String
    Dim buf, ret As Long
    URL = Worksheets("Sheet1").Range("A2").Value
    buf = Split(URL, ".")
    ext = buf(UBound(buf))
    strSavePath = "C:\Users\rshuell\Desktop\Downloads\" & "DownloadedFile." & ext
    ret = URLDownloadToFile(0, URL, strSavePath, 0, 0)
    If ret = 0 Then
        MsgBox "Download has been succeed!"
    Else
        MsgBox "Error"
    End If
End Sub

Now, if you just want to download one single file, run the script below.

Sub DownloadFileWithVBA()

Dim myURL As String
'Right-click on the link named 'Sample Address File'
'Click 'Copy Link Location'
'Paste the link below
myURL = "http://databases.about.com/library/samples/address.xls"

Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False
WinHttpReq.Send

myURL = WinHttpReq.ResponseBody
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write WinHttpReq.ResponseBody
    oStream.SaveToFile ("C:\Users\Excel\Desktop\address.xls")
    oStream.Close

End Sub

Upvotes: 3

Related Questions