Results 1 to 7 of 7

Thread: VBA to download images and rename
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Jul 2019
    Posts
    8
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Cool VBA to download images and rename

    Hi

    i have an excel file with links to images in column L i need to download them and rename them with the list in column M

    Thanks !

  2. #2
    Board Regular
    Join Date
    Oct 2007
    Posts
    5,833
    Post Thanks / Like
    Mentioned
    8 Post(s)
    Tagged
    2 Thread(s)

    Default Re: VBA to download images and rename

    Try adapting the code at https://www.mrexcel.com/forum/excel-...ml#post5080413

    One change, to use the links in column L and save them as the names in column M:

    Code:
        With ActiveSheet
            lr = .Cells(Rows.Count, "L").End(xlUp).row
            For r = 2 To lr
                DownloadFile .Cells(r, "L").Value, saveInFolder & .Cells(r, "M").Value & ".jpg"
            Next
        End With
    Remove the & ".jpg" if the file names in column M the file extension (e.g. ".jpg"), and change the saveInFolder as required.

    NB back slashes are missing from the linked code. The saveInFolder lines should be:
    Code:
        saveInFolder = ThisWorkbook.Path & "\"
        If Right(saveInFolder, 1) <> "\" Then saveInFolder = saveInFolder & "\"
    Last edited by John_w; Jul 19th, 2019 at 07:14 AM. Reason: Back slashes note

  3. #3
    New Member
    Join Date
    Jul 2019
    Posts
    8
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to download images and rename

    Quote Originally Posted by John_w View Post
    Try adapting the code at https://www.mrexcel.com/forum/excel-...ml#post5080413

    One change, to use the links in column L and save them as the names in column M:

    Code:
        With ActiveSheet
            lr = .Cells(Rows.Count, "L").End(xlUp).row
            For r = 2 To lr
                DownloadFile .Cells(r, "L").Value, saveInFolder & .Cells(r, "M").Value & ".jpg"
            Next
        End With
    Remove the & ".jpg" if the file names in column M the file extension (e.g. ".jpg"), and change the saveInFolder as required.

    NB back slashes are missing from the linked code. The saveInFolder lines should be:
    Code:
        saveInFolder = ThisWorkbook.Path & "\"
        If Right(saveInFolder, 1) <> "\" Then saveInFolder = saveInFolder & "\"

    Code:
    #If  VBA7 Then
    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
    Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" _
        (ByVal lpszUrlName As String) 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
    Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" _
        (ByVal lpszUrlName As String) As Long
    #End  If
    
    
    Private Const BINDF_GETNEWESTVERSION As Long = &H10
    
    
    
    
    Public Sub Download_Images()
        
        Dim lr As Long, r As Long
        Dim saveInFolder As String
        
        
        
        saveInFolder = ThisWorkbook.Path & ""
        If Right(saveInFolder, 1) <> "" Then saveInFolder = saveInFolder & ""
        
        
        With ActiveSheet
            lr = .Cells(Rows.Count, "L").End(xlUp).Row
            For r = 2 To lr
                DownloadFile .Cells(r, "L").Value, saveInFolder & .Cells(r, "M").Value & ".jpg"
            Next
        End With
        
    End Sub
    
    
    
    
    Private Function DownloadFile(URL As String, LocalFilename As String) As Boolean
        
        Dim retVal As Long
        
        DeleteUrlCacheEntry URL
        retVal = URLDownloadToFile(0, URL, LocalFilename, BINDF_GETNEWESTVERSION, 0)
        If retVal = 0 Then DownloadFile = True Else DownloadFile = False
    
    
    End Function
    I tried to run this code but it's not doing anything i also dont know where to put the saving path i want it to be saved on c:\a

  4. #4
    Board Regular
    Join Date
    Oct 2007
    Posts
    5,833
    Post Thanks / Like
    Mentioned
    8 Post(s)
    Tagged
    2 Thread(s)

    Default Re: VBA to download images and rename

    Give examples of the links (URLs) and file names.

  5. #5
    New Member
    Join Date
    Jul 2019
    Posts
    8
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to download images and rename

    Quote Originally Posted by John_w View Post
    Give examples of the links (URLs) and file names.

    http://slimages.dsadas.com/is/image/dsad/11232070

    file name : fsafasf no extension

  6. #6
    Board Regular
    Join Date
    Oct 2007
    Posts
    5,833
    Post Thanks / Like
    Mentioned
    8 Post(s)
    Tagged
    2 Thread(s)

    Default Re: VBA to download images and rename

    That URL is not an image.

  7. #7
    New Member
    Join Date
    Jul 2019
    Posts
    8
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to download images and rename

    Inside the link there is an image

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •