Saving a PDF after it is opened via Excel hyperlink

[J Harper]

How can I automate the saving of a PDF file after it is opened via an Excel hyperlink? I open the pdf file via hyperlink and then save to a specific subdirectory after naming the file. I need to do this 100s of times within each Excel.

 

[J Harper]

​

I need to open 1 or many PDF files via hyperlink (1 hyperlink per row in column T), save this PDF using a the file name from column E to a specific folder, then go to next row until complete. There could be 100s of hyperlinks in 1 spreadsheet. I need the macro code to accomplish. I can opened the files but I do not yet a way to save these PDF files to the selected folder using the desired file name. The general steps are:
1) Open Excel
2) Click on hyperlink in field cell "T2" to open pdf file "123456.PDF", after "123456.PDF" is open,
3) Save "123456.PDF" to a selected folder c:/files/pdfs/ and change the name of "123456.PDF" to "WI-123456.PDF" resulting in newly named pdf in folder c:/files/pdfs/WI-123456.PDF
4) Go to cell "T3" and perform again
5) Go to cell "T4" and perform again
6) Keep performing until there are no more rows of data

 

[John_w]

Why do you need to open the PDFs? It seems you could loop through the hyperlinks and create a copy of each PDF with FileCopy source, destination.

 

[J Harper]

I assumed I needed to open them in order to save them. i do not need to open them, i simply need to save them to a folder.

 

[John_w]

Try this macro, which assumes the new file names in column E don't have the ".pdf" extension; if they do delete the & ".pdf" in the code.

Public Sub Copy_Hyperlinked_Files()

    Dim destFolder As String
    Dim lastRow As Long, r As Long
    
    destFolder = "C:\files\pdfs\"
    
    If Right(destFolder, 1) <> "\" Then destFolder = destFolder & "\"
    With ActiveSheet
        lastRow = .Cells(.Rows.Count, "T").End(xlUp).Row
        For r = 2 To lastRow
            FileCopy .Cells(r, "T").Hyperlinks(1).Address, destFolder & .Cells(r, "E").Value & ".pdf"
        Next
    End With
    
End Sub

 

[J Harper]

The syntax SOURCE hyperlink in my excel spreadsheet in column T looks like
"

Login

idcloud.yoursp.com

"
Do i need to do something different in the MACRO? Currently I get a "SUBSCRIPT OUT OF RANGE" Error when I run it.

 

[J Harper]

Looks like, "Login"

I have access to the files once I log into the cloud location.

 

[John_w]

I thought the PDFs were on your computer.

Do i need to do something different in the MACRO? Currently I get a "SUBSCRIPT OUT OF RANGE" Error when I run it.

Which line? Click Debug on the error message and the errant line is highlighted. Does the active sheet contain hyperlinks in column T starting at T2? If not, that would cause the error.

Try this macro instead, which downloads each file from its hyperlink address.

#If VBA7 Then
    Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon.dll" Alias "URLDownloadToFileA" _
        (ByVal pCaller As LongPtr, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As LongPtr) As Long
#Else
    Private Declare Function URLDownloadToFile Lib "urlmon.dll" Alias "URLDownloadToFileA" _
        (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#End If

Private Const BINDF_GETNEWESTVERSION As Long = &H10


Public Sub Copy_Hyperlinked_Files()

    Dim destFolder As String
    Dim lastRow As Long, r As Long
    
    destFolder = "C:\files\pdfs\"
    
    If Right(destFolder, 1) <> "\" Then destFolder = destFolder & "\"
    With ActiveSheet
        lastRow = .Cells(.Rows.Count, "T").End(xlUp).Row
        For r = 2 To lastRow
            DownloadFile .Cells(r, "T").Hyperlinks(1).Address, destFolder & .Cells(r, "E").Value & ".pdf"
        Next
    End With
    
End Sub


Private Function DownloadFile(url As String, localFilename As String) As Boolean
    
    Dim retVal As Long
    
    retVal = URLDownloadToFile(0, url, localFilename, BINDF_GETNEWESTVERSION, 0)
    If retVal = 0 Then DownloadFile = True Else DownloadFile = False

End Function

 

[J Harper]

Yes, the hyperlink starts in T2. I am getting the same error on the same line as noted in the posted ERROR image. I also posted a copy of the HYPERLINK STRING syntax in cells T2 and T3. The hyperlink is grabbing a file/image that is presented in the Document Viewer.

 

[John_w]

Are the hyperlinks just text then, not created via Insert -> Link? If so, change the DownloadFile call to:

           DownloadFile .Cells(r, "T").Value, destFolder & .Cells(r, "E").Value & ".pdf"