VBA To Save PDF's from hyperlink as cell reference

[ForrestGump01]

Hello all,

This should be a fairly easy macro for you guru's...

I have a large set of invoice data by row -- Column A is a hyperlink that opens and downloads the specific invoice .pdf (to downloads folder), Column B is the "Save as" file name. I simply want to run a macro to open each link and save the file to a specified folder (e.g. C:\Desktop\Vendor Invoices) as the file name in the corresponding row and then continue onto the next row.

There are hundreds of thousands of rows of data spanning multiple years, so this macro must be automatic and require no user interface after beginning to run the macro. I only need to run it once to save these invoices.

All help is GREATLY appreciated!

[Croweater]

Is this something like you want?

Option Explicit

#If VBA7 And Win64 Then

    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr

#Else

    Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

    Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

#End If

Const WM_CLOSE = &H10

Sub SavePdfs()

 

Dim linkfile As Hyperlink

Dim savelocation As String

Dim PdfFile As String

 

savelocation = "C:\yourfolder\"

Application.ScreenUpdating = False

 

For Each linkfile In ThisWorkbook.Sheets("Sheet1").Hyperlinks

    ActiveWorkbook.FollowHyperlink linkfile.Address

    PdfFile = savelocation & linkfile.Range.Offset(0, 1).Value & ".pdf"

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, _

    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

    Close_Adobe_Reader

Next

Application.ScreenUpdating = True

End Sub

 

 

Sub Close_Adobe_Reader()

    Dim strClassName As String

    Dim hwnd As Variant

    strClassName = "AcrobatSDIWindow"

    hwnd = FindWindow(strClassName, vbNullString)

    If hwnd Then

        SendMessage hwnd, WM_CLOSE, 0, ByVal 0&

    Else

        MsgBox "Adobe is not running !"

    End If

End Sub

[ForrestGump01]

Is this something like you want?

Option Explicit

#If VBA7 And Win64 Then

    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr

#Else

    Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

    Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

#End If

Const WM_CLOSE = &H10

Sub SavePdfs()

 

Dim linkfile As Hyperlink

Dim savelocation As String

Dim PdfFile As String

 

savelocation = "C:\yourfolder\"

Application.ScreenUpdating = False

 

For Each linkfile In ThisWorkbook.Sheets("Sheet1").Hyperlinks

    ActiveWorkbook.FollowHyperlink linkfile.Address

    PdfFile = savelocation & linkfile.Range.Offset(0, 1).Value & ".pdf"

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, _

    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

    Close_Adobe_Reader

Next

Application.ScreenUpdating = True

End Sub

 

 

Sub Close_Adobe_Reader()

    Dim strClassName As String

    Dim hwnd As Variant

    strClassName = "AcrobatSDIWindow"

    hwnd = FindWindow(strClassName, vbNullString)

    If hwnd Then

        SendMessage hwnd, WM_CLOSE, 0, ByVal 0&

    Else

        MsgBox "Adobe is not running !"

    End If

End Sub

Thanks for the reply.

The

#Else

    Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

    Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

#End If

code is resulting in an error, as well as

For Each linkfile In ThisWorkbook.Sheets("Sheet1").Hyperlinks

    ActiveWorkbook.FollowHyperlink linkfile.Address

    PdfFile = savelocation & linkfile.Range.Offset(0, 1).Value & ".pdf"

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, _

    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

    Close_Adobe_Reader

I don't fully understand the logic of the code you suggested as my VBA knowledge is nil -- However I would like to clarify that when I click the hyperlinks in my data it opens a browser that simply downloads the file -- that is, that the file gets automatically saved to downloads with a messy and meaningless alphanumeric string as the file name. Is this process maybe easier if the VBA were to simply "select the link to open in browser" -> "rename file in downloads" -> "Cut/paste file to different destination folder"?

[Croweater]

Yeah. It was a guess on my part as to what you already have.

Can you put a sample workbook up? (Yellow banner at top of page).

[ForrestGump01]

Sure thing, see the attached simplified file. This is basically the layout of my file. I simply want to download the invoice from the link, have it save to a specific folder, with a specific name.

[ForrestGump01]

Yeah. It was a guess on my part as to what you already have.

Can you put a sample workbook up? (Yellow banner at top of page).

Here you go! The only difference between this test and my actual data is that when someone clicks the hyperlink it automatically downloads the .pdf instead of opening it to view in the browser. The hyperlinks from my invoice data open the browser and download the invoice file to the "downloads" folder. I simply want to save those files as a specified name in a specified folder as is listed by row in sheet 1. I have roughly 30,000 lines of data right now.

[ByteMarks]

You could use the URLDownloadToFile API

In the sheet module.

 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 download()
Dim lr As Long, r As Long

Const DestPath As String = "C:\DownloadedFiles\" 'change accordingly with \ at the end

lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = 2 To lr
    Application.StatusBar = r - 1 & " of " & lr - 1
    URLDownloadToFile 0, Range("A" & r).Value, DestPath & Range("B" & r).Value & ".pdf", 0, 0
    DoEvents
Next
Application.StatusBar = False
End Sub

[ForrestGump01]

You could use the
In the sheet module.

 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 download()
Dim lr As Long, r As Long

Const DestPath As String = "C:\DownloadedFiles\" 'change accordingly with \ at the end

lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = 2 To lr
    Application.StatusBar = r - 1 & " of " & lr - 1
    URLDownloadToFile 0, Range("A" & r).Value, DestPath & Range("B" & r).Value & ".pdf", 0, 0
    DoEvents
Next
Application.StatusBar = False
End Sub

How do I declare the loop to save each file to their own folder location with their own name as specified by the column? Like where do I tell the VBA to retrieve the file name and folder location as referencing columns B and C for the specific row it's exporting?

[ByteMarks]

This takes the save-to folder from column C and new name from B

 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 download()
Dim lr As Long, r As Long
Dim FileToDownLoad$, NewFileName$, NewFilePath$


lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = 2 To lr
    Application.StatusBar = r - 1 & " of " & lr - 1
    
    FileToDownLoad = Range("A" & r).Value
    NewFileName = Range("B" & r).Value & ".pdf"
    NewFilePath = Range("C" & r).Value: If Left(NewFilePath, 1) <> "\" Then NewFilePath = NewFilePath & "\"
    
    
    URLDownloadToFile 0, FileToDownLoad, NewFilePath & NewFileName, 0, 0
    DoEvents
Next
Application.StatusBar = False
End Sub

[ForrestGump01]

This takes the save-to folder from column C and new name from B

 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 download()
Dim lr As Long, r As Long
Dim FileToDownLoad$, NewFileName$, NewFilePath$


lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = 2 To lr
    Application.StatusBar = r - 1 & " of " & lr - 1
    
    FileToDownLoad = Range("A" & r).Value
    NewFileName = Range("B" & r).Value & ".pdf"
    NewFilePath = Range("C" & r).Value: If Left(NewFilePath, 1) <> "\" Then NewFilePath = NewFilePath & "\"
    
    
    URLDownloadToFile 0, FileToDownLoad, NewFilePath & NewFileName, 0, 0
    DoEvents
Next
Application.StatusBar = False
End Sub

Thanks for this -- Code is running, which is a good start, although it doesn't seem to be saving the invoices into my folder(s) while its running in the background. Question, do I need to already have the sub-folders created (e.g. "Accounting" / "Finance") or will this macro create those folders within my parent folder? Im thinking this might be the hold-up on why the invoices aren't saving...

[ByteMarks]

This will check for the folder and create it if necessary

 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 download()
Dim lr As Long, r As Long
Dim FileToDownLoad$, NewFileName$, NewFilePath$


lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = 2 To lr
    Application.StatusBar = r - 1 & " of " & lr - 1
    
    FileToDownLoad = Range("A" & r).Value
    NewFileName = Range("B" & r).Value & ".pdf"
    NewFilePath = Range("C" & r).Value
    If Len(Dir(NewFilePath, vbDirectory)) = 0 Then MkDir (NewFilePath)
    URLDownloadToFile 0, FileToDownLoad, NewFilePath & "\" & NewFileName, 0, 0
    DoEvents
Next
Application.StatusBar = False
End Sub

[ForrestGump01]

This will check for the folder and create it if necessary

 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 download()
Dim lr As Long, r As Long
Dim FileToDownLoad$, NewFileName$, NewFilePath$


lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = 2 To lr
    Application.StatusBar = r - 1 & " of " & lr - 1
    
    FileToDownLoad = Range("A" & r).Value
    NewFileName = Range("B" & r).Value & ".pdf"
    NewFilePath = Range("C" & r).Value
    If Len(Dir(NewFilePath, vbDirectory)) = 0 Then MkDir (NewFilePath)
    URLDownloadToFile 0, FileToDownLoad, NewFilePath & "\" & NewFileName, 0, 0
    DoEvents
Next
Application.StatusBar = False
End Sub

This code is working perfectly -- thank you.

One question though: How do I know where the code stops if there's an interruption? Is it safe to assume that this vba is stepping linearly down row by row such that if the last export was data from row 5789, I could safely assume that everything before row 5789 has been exported and everything 5790+ is un-exported? Problem is there's so much data and if my internet goes out (ex. end of work day before getting home) the macro stops and I have no idea where it last left off.

Thank you!