Automatically Download PDF Links to Desktop Folder

[Hoosiers18]

Hi,

I have code that currently loops through a list of hyperlinks in Excel and batch downloads these links as PDFs. I am having trouble controlling where these downloads ave. Sometimes they save to my desktop, documents, or another file path. Ideally, I would like them to be saved into a designated folder on my desktop named "PDFs." Below is the code I currently have:


Declare PtrSafe 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

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

Sub DownloadPDFs()
Dim StartRowNum As Long
Dim EndRowNum As Long
Dim pdfname As String
Dim RecordNum As String
Dim URLprefix As String
LastRowPDF = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row
For i = 2 To LastRowPDF
Application.ScreenUpdating = False
URLprefix = Sheet1.Cells(i, 2)
RecordNum = Sheet1.Cells(i, 3)
pdfname = RecordNum & ".pdf"
URL = URLprefix
DownloadFile URLprefix, pdfname
Application.ScreenUpdating = True

Next i

End Sub


If anyone knows how to make this code save into a specific folder path, that would be greatly appreciated! Thank you.

 

[Worf]

Welcome

An example:

autom(AutoRecovered)nov20.xlsm
	B	C
1	URL	Path
2	https://www.wisdomaxis.com/technology/software/data/for-reports/Orders-With%20Nulls.xlsx	c:\test\Orders-With%20Nulls.xlsx
3	https://www.wisdomaxis.com/technology/software/data/for-reports/Data%20Blending%20File%20One.xlsx	c:\test\Data%20Blending%20File%20One.xlsx
search

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

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

Sub DownloadXL()
Dim StartRowNum As Long, i%, sh As Worksheet, filepath$
Set sh = ActiveSheet
For i = 2 To sh.Cells(Rows.Count, "B").End(xlUp).row
    With WorksheetFunction
        filepath = "c:\test\" & Mid(sh.Cells(i, 2), .Find("*", _
        .Substitute(sh.Cells(i, 2), "/", "*", Len(sh.Cells(i, 2)) - _
        Len(.Substitute(sh.Cells(i, 2), "/", "")))) + 1, Len(sh.Cells(i, 2)))
    End With
    sh.Cells(i, 3) = filepath
    If DownloadFile(sh.Cells(i, 2), sh.Cells(i, 3)) Then MsgBox "Success!", , i
Next
End Sub

 

[John_w]

I would like them to be saved into a designated folder on my desktop named "PDFs."

Insert before the loop:

    Dim folder As String
    folder = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\PDFs\"

And replace:

DownloadFile URLprefix, pdfname

with:

    DownloadFile URLprefix, folder & pdfname

PS please use VBA tags.