I have code that loops through a list of hyperlinks in Excel and batch downloads these links as PDFs.
Sometimes they save to my desktop, documents, or another file path.
I would like them saved to a designated folder on my desktop named "PDFs."
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
How do I save to a specific folder path?
This is the method I use and it works well, especially if you may need to use the file on multiple computers where the user profile may change, for example sending to others to execute the print operation or printing from another desktop. This method does not set a static path specific to your PC, but rather a path according to the PC it is being run on. A more flexible solution.
'Set Filename
pdfname = Environ("UserProfile") & "\Desktop\PDFs\" & RecordNum & ".pdf"
Related
I'm currently creating a program that downloads URL links as PDF and stores it into my local storage. The problem is that, when it encounters a duplicate name then it overwrites. Any thoughts on instead of overwriting the existing file, It should just add (2) on the end.
My code here is
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As LongPtr, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As LongPtr) As Long
Sub DownloadFile()
Dim downloadStatus As Variant
Dim Url As String
Dim destinatioFile_Local As String
Dim i As Integer
i = 1
Do Until IsEmpty(Cells(i, 1)) = True
Url = (Cells(i, 1))
destinationFile_local = "C:\Users\name\Desktop\test" & filename(Cells(i, 1))
downloadStatus = URLDownloadToFile(0, Url, destinationFile_local, 0, 0)
If downloadStatus = 0 Then
MsgBox "Downloaded"
Else
MsgBox "Download fail"
End If
i = i + 1
Loop
End Sub
Function filename(file_fullname) As String
filename = Mid(file_fullname, InStrRev(file_fullname, "/") + 1)
End Function
I have been using this code to download images with excel and rename files, but all of sudden the size of the downloaded file is coming 1.47 kb and the file is not readable.
Can you help where i am going wrong.
Any help will be appreciated.
Option Explicit
Private 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
Dim Ret As Long
Sub Sample()
Dim FolderName As String
Dim ws As Worksheet
Dim LastRow As Long, i As Long
Dim strPath As String
FolderName = Range("$B$2").Value
Set ws = Sheets("Sheet1")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
For i = 4 To LastRow
strPath = FolderName & ws.Range("A" & i).Value & ".jpg"
Ret = URLDownloadToFile(0, ws.Range("B" & i).Value, strPath, 0, 0)
If Ret = 0 Then
ws.Range("C" & i).Value = "Downloaded"
Else
ws.Range("C" & i).Value = "Error"
End If
Next i
End Sub
I found an answer in other site: Try investigating the downloaded file using some text editor, Notepad, for example. Maybe, instead of a JPG file, you will see in "filename.jpg" a text or HTML containing some error message!, perhaps related to security stuffs (in my case, Google was asking for login in google to download the file). Maybe the file is not publicly available, and you cannot download it using your code because Google expects a password.
I want to print the list pdf file which it have name in 1 column of excel .
I don't want to hold the button Ctrl and find name of it one by one in column of excel and choose those file . Because may be have a lot of file . Find one by one take a lot of time.
For example with the image above.
What software can support for me do this ? Or have to I do any thing to done this problem ???.
Thank you for read my post !!!
This should work:
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Function PrintPDF(xlHwnd As Long, FileName As String) As Boolean
Dim X As Long
On Error Resume Next
X = ShellExecute(xlHwnd, "Print", FileName, 0&, 0&, 3)
If Err.Number > 0 Then
MsgBox Err.Number & ": " & Err.Description
PrintPDF = False
Else
PrintPDF = True
End If
On Error GoTo 0
End Function
Sub PrintSpecificPDF()
'opens the specified pdf and prints it using the default printer
'note that it uses the default PDF program and leaves it open
Dim strPth As String, strFile As String
Dim rngList As Range, rngTarget As Range
Set rngList = Range(Range("B2"), Range("B1").End(xlDown))
strPth = "D:\PDF\"
For Each rngTarget In rngList
strFile = rngTarget.Value & ".pdf"
If Not PrintPDF(0, strPth & strFile) Then
MsgBox "Printing failed"
End If
Next
End Sub
I've taken this code and slightly modified it according to your case.
I am trying to automaticly send to printer all .pdf file from a folder.
Here is the code I am trying
Option Explicit
Declare Function apiShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) _
As Long
Public Sub PrintFile(ByVal strPathAndFilename As String)
Call apiShellExecute(Application.hwnd, "print", strPathAndFilename, vbNullString, vbNullString, 0)
End Sub
Sub Test()
Dim filepath As String
Dim currfile As String
Dim wrdApps As Object
Dim wrdDoc As Object
Set wrdApps = CreateObject("Word.Application")
filepath = ActiveWorkbook.Path & "\AIMPRIMER\"
currfile = Dir(filepath & "*.PDF")
Do While currfile <> ""
PrintFile (filepath + currfile)
currfile = Dir()
Loop
End Sub
Do While Is used to browse all pdf file from the folder
PrintFile (filepath + currfile) Must send the current file to printer.
I except this to print all .pdf once but actually the do while loop isn't working as accepted, the do while loop is looping and never stop.
I tried : Debug.Print filepath + currfile here i got all .PDF 's path once, But this path isn't send once to the printer.
So I don't understand why Debug.Print filepath + currfile is working nicely and when I use PrintFile (filepath + currfile) the printer print and never stop printing...
It seems that the API call is throwing off the Dir, although I'm not able to replicate this problem (it seems my initial attempt did produce the infinite loop, but I'm not able to reproduce it a second time...). Best to build the list of files first.
Dim filepath$, currfile$, item
Dim files As New Collection
filepath = "C:\debug\"
currfile = Dir(filepath & "*.pdf")
' build a list of files to be printed later
Do While currfile <> ""
files.Add filepath + currfile
currfile = Dir()
Loop
' print each file in the list we created in previous loop
For Each item In files
PrintFile currfile
Next
I have a excel list with a lot of article numbers, eg. "23378847". And I want the pictures of all my article numbers in the list stored in my folder.
But the result will be as under. It should be 23378847.jpg not 152499
http://media.byggtjeneste.no/media/bilde/152499/LargeThumbnail
or
http://www.nobb.no/Nobbnr/OrginalBilde/23378847/152499
Is there a way that I can make a scrips that read my file and save the pic with the same article number as in the list?
Here is a sample which will help you.
I am assuming that your Excel file will look like this. Please amend the code as applicable.
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
Dim Ret As Long
'~~> This is where the images will be saved. Change as applicable
Const FolderName As String = "C:\Temp\"
Sub Sample()
Dim ws As Worksheet
Dim LastRow As Long, i As Long
Dim strPath As String
'~~> Name of the sheet which has the list
Set ws = Sheets("Sheet1")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow '<~~ 2 because row 1 has headers
strPath = FolderName & ws.Range("A" & i).Value & ".jpg"
Ret = URLDownloadToFile(0, ws.Range("B" & i).Value, strPath, 0, 0)
If Ret = 0 Then
ws.Range("C" & i).Value = "File successfully downloaded"
Else
ws.Range("C" & i).Value = "Unable to download the file"
End If
Next i
End Sub
For those who don't want to deal with VBA or any other programming language there is a desktop web app that makes it super simple.
Just drop in the excel file, it will download all the images (or files) in an excel file to the folder you select, and if there are names on the B column it will also rename the file.
The latest release can be found on https://github.com/btargac/excel-parser-processor.