GET pictures from a url and then rename the picture - excel

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.

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.

Downloading Photos from excel links

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

Download a set of images from Excel with their names using a macros

I want to run a VBScript macro to download a set of images from an URL which can de sorted by the key , (comma). I have to name each image with names given in the secondary column. For example: I have 2 columns and 5 rows. In column "A" I have all the names of the images and in column "B" I have all the URL links which can be sorted by the ,. Now I want to download all the images with their names in column "A" and for the second set of images it should rename column "A" by adding 2 at the end of each row, and then it should start downloading the second set of images. Same should go for the 3rd set or 4th set until the image set ends. Sometimes there might be only one image URL in column "B".
Here is the script which I tried to download but I was not able to sort the images and download it by renaming it again.
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
VBScript is not VB, all variables in VBScript are automatically of type Variant and does not directly support API's. It utilizes COM objects instead.
You have to implement a new function that does the same like URLDownloadToFile API call from urlmon.dll.
This should work:
Function URLDownloadToFile(szURL, szFileName, OverWrite)
On Error Resume Next
Dim FSO: Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
Dim ADO_STREAM: Set ADO_STREAM = WScript.CreateObject("ADODB.Stream")
Dim HTTP: Set HTTP = WScript.CreateObject("Microsoft.XMLHTTP")
HTTP.Open "GET", CStr(szURL), False
HTTP.Send
If Err.Number <> 0 Then
WScript.Echo "An error has occured, Not connected to a network" + VbCrLf + "Error " + CStr(Err.Number) + ", " + CStr(Err.Description)
Err.Clear
URLDownloadToFile = CInt(-1)
Exit Function
End If
With ADO_STREAM
.Type = 1
.Open
.Write HTTP.ResponseBody
.SaveToFile szFileName, (CInt(OverWrite) + 1)
End With
If Err.Number <> 0 Then
WScript.Echo "URLDownloadToFile failed, Error " + CStr(Err.Number) + VbCrLf + CStr(Err.Description)
Err.Clear
URLDownloadToFile = CInt(-1)
Exit Function
End If
If (Err.Number = 0) And (FSO.FileExists(szFileName) = True) Then
URLDownloadToFile = CInt(0)
End If
On Error Goto 0
End Function
Usage of this function:
Ret = URLDownloadToFile(ws.Range("B" & i).Value, strPath, 1)
About OverWrite parameter:
Valid values: 0 or 1
1 overwrites existing file and 0 creates a new file if file doesn't exist.
If the file downloaded successfully, above function returns 0 and otherwise it returns -1 (In case any error).
Define following, so you can get the last row in Excel.
'~~> Define xlUp
Const xlUp = -4162
You must create an object referring Excel Application like:
Dim Excel: Set Excel = WScript.CreateObject("Excel.Application")
Use Excel.Sheets, instead of using only Sheets in VB. Example:
Set ws = Excel.Sheets("Sheet1")
IMPORTANT: Change your code as applicable.
Dim Ret
'~~> This is where the images will be saved.
Const FolderName = "E:\TEST\"
Sub Sample()
Dim ws, LastRow, i, strPath
'~~> Name of the sheet which has the list
Set ws = Excel.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(ws.Range("B" & i).Value, strPath, 1) '<~~ 1 to overwrite existing file
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
End Sub

Resources