Downloading Photos from excel links - excel

I have a massive excel file that has a huge amount of hyperlinks to images. My client would like these images in a zipped folder of course.
I have never touched VB code before so I have no idea what I'm doing. I have this, but I'm not really sure what to put into the 'range'...because again I have no experience with this. Some help would be appreciated. I keep getting 'runtime error 9'
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:\Users\person\Desktop\images"
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 = 4 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
and a sample of the kind of data. I'm just trying to pull the images out

Related

Automatically Download PDF Links to Desktop Folder

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"

Unable to download images with excel

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.

How can I print list pdf file with name them in column excel?

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.

URLDownloadToFile Error: INET_E_SECURITY_PROBLEM

I'm modifying code to download multiple files via Excel VBA.
The code is as follows:
Option Explicit
'API function declaration for both 32 and 64bit Excel.
#If VBA7 Then
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
#Else
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
#End If
Sub DownloadFiles()
'--------------------------------------------------------------------------------------------------
'The macro loops through all the URLs (column C) and downloads the files at the specified folder.
'The characters after the last "/" of the URL string are used to create the file path.
'If the file is downloaded successfully an OK will appear in column D (otherwise an ERROR value).
'The code is based on API function URLDownloadToFile, which actually does all the work.
'Written By: Christos Samaras
'Date: 02/11/2013
'Last Update: 06/06/2015
'E-mail: xristos.samaras#gmail.com
'Site: https://myengineeringworld.net/////
'--------------------------------------------------------------------------------------------------
'Declaring the necessary variables.
Dim sh As Worksheet
Dim DownloadFolder As String
Dim LastRow As Long
Dim SpecialChar() As String
Dim SpecialCharFound As Double
Dim FilePath As String
Dim i As Long
Dim j As Integer
Dim Result As Long
Dim CountErrors As Long
'Disable screen flickering.
Application.ScreenUpdating = False
'Set the worksheet object to the desired sheet.
Set sh = Sheets("Sheet1")
'An array with special characters that cannot be used for naming a file.
SpecialChar() = Split(" / : * ? " & Chr$(34) & " < > |", " ")
'Find the last row.
With sh
.Activate
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
End With
'Check if the download folder exists.
DownloadFolder = sh.Range("B4")
On Error Resume Next
If Dir(DownloadFolder, vbDirectory) = vbNullString Then
MsgBox "The folder's path is incorrect!", vbCritical, "Folder's Path Error"
sh.Range("B4").Select
Exit Sub
End If
On Error GoTo 0
'Check if there is at least one URL.
If LastRow < 8 Then
MsgBox "You did't enter a single URL!", vbCritical, "No URL Error"
sh.Range("C8").Select
Exit Sub
End If
'Clear the results column.
sh.Range("D8:D" & LastRow).ClearContents
'Add the backslash if doesn't exist.
If Right(DownloadFolder, 1) <> "" Then
DownloadFolder = DownloadFolder & ""
End If
'Counting the number of files that will not be downloaded.
CountErrors = 0
'Save the internet files at the specified folder of your hard disk.
On Error Resume Next
For i = 8 To LastRow
'Find the characters after the last "/" of the URL.
With WorksheetFunction
FilePath = Mid(sh.Cells(i, 3), .Find("*", .Substitute(sh.Cells(i, 3), "/", "*", Len(sh.Cells(i, 3)) - _
Len(.Substitute(sh.Cells(i, 3), "/", "")))) + 1, Len(sh.Cells(i, 3)))
End With
'Check if the file path contains a special/illegal character.
For j = LBound(SpecialChar) To UBound(SpecialChar)
SpecialCharFound = InStr(1, FilePath, SpecialChar(j), vbTextCompare)
'If an illegal character is found substitute it with a "-" character.
If SpecialCharFound > 0 Then
FilePath = WorksheetFunction.Substitute(FilePath, SpecialChar(j), "-")
End If
Next j
'Create the final file path.
FilePath = DownloadFolder & FilePath
'Check if the file path exceeds the maximum allowable characters.
If Len(FilePath) > 255 Then
sh.Cells(i, 4) = "ERROR"
sh.Cells(i, 2) = "ERROR1"
CountErrors = CountErrors + 1
End If
'If the file path is valid, save the file into the selected folder.
If UCase(sh.Cells(i, 4)) <> "ERROR" Then
'Try to download and save the file.
Result = URLDownloadToFile(0, sh.Cells(i, 3), FilePath, 0, 0)
'Check if the file downloaded successfully and exists.
If Result = 0 And Not Dir(FilePath, vbDirectory) = vbNullString Then
'Success!
sh.Cells(i, 4) = "OK"
sh.Cells(i, 2) = Result & "&" & FilePath & "&" & vbDirectory
Else
'Error!
sh.Cells(i, 4) = "ERROR"
sh.Cells(i, 2) = Result & "&" & FilePath & "&" & vbDirectory
CountErrors = CountErrors + 1
End If
End If
Next i
On Error GoTo 0
'Enable the screen.
Application.ScreenUpdating = True
'Inform the user that macro finished successfully or with errors.
If CountErrors = 0 Then
'Success!
If LastRow - 7 = 1 Then
MsgBox "The file was successfully downloaded!", vbInformation, "Done"
Else
MsgBox LastRow - 7 & " files were successfully downloaded!", vbInformation, "Done"
End If
Else
'Error!
If CountErrors = 1 Then
MsgBox "There was an error with one of the files!", vbCritical, "Error"
Else
MsgBox "There was an error with " & CountErrors & " files!", vbCritical, "Error"
End If
End If
End Sub
This code downloads most files just fine, but I ran across issues when trying to download from SPP(Southwest Power Pool)'s API. For Example:
https://marketplace.spp.org/file-api/download/da-lmp-by-location?path=%2F2018%2F11%2FDA-LMP-MONTHLY-SL-201811.csv
This file or any similar file that I try to download from this api is identified and downloaded just fine by any browser or download manager, but URLDownloadToFile reports an error and does not download the file. It downloads files from other sources successfully
My knowledge of coding allowed me to track down the error/return code, which is reported in column B by the following bit of code:
sh.Cells(i, 2) = Result & "&" & FilePath & "&" & vbDirectory
To my understanding, this indicates INET_E_SECURITY_PROBLEM with return code of -2146697202.
Beyond Identifying the error, I am out of my depth.
Assistance in figuring out how to get past this major roadblock would be greatly appreciated.

GET pictures from a url and then rename the picture

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.

Resources