Macro Only Process on Visible Cells

[alex0182828]

I have this macro to download images and rename them. It starts on the second row, downloads the url from B2 and renames it with the value from B1 then proceeds till it does not find any more images.

I am trying to :

(1) Make it only work on the visable cells if the list if filtered
(2) Prompt the user to browse to the location to save the files

Any help would be great.

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:\img\"

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

 

[Rosen]

In theory, if you check the Hidden property, it should behave in the manner you wish. like this:

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:\img\"
 Sub Sample()
     Dim ws As Worksheet
     Dim LastRow As Long, i As Long
     Dim strPath As String
     Dim FolderName As String
     
     With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        FolderName = .SelectedItems(1)
     End With
    
     '~~> 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
        If ws.Range("A" & i).Hidden = False Then
             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
        End If
     Next i
 End Sub

Always backup your work before running new code!

Hope this helped.

 

[Rosen]

I just caught another mistake in my post (and it will not allow me to edit it again for some reason), the FolderPicker does not give back "Drive:\Folder\" but "Drive:\Folder" you will need to add & "\" after .SelectedItems(1)

That is,

FolderName = .SelectedItems(1) & "\"

 

[alex0182828]

Hi Rosen,

Thanks for taking the time to help me out. I updated the code to include the second change. However i am getting an error with the hidden rows part of the formula ..

Example of my data when i tried to run your macro :

The image url in the example does not work, but i tested it with an working image url.

 

[Rosen]

Change the line

If ws.Range("A" & i).Hidden = False Then

to

If ws.Rows(i).Hidden = False Then

 

[alex0182828]

Hi Rosen,

That worked a treat. Thanks for the help the full corrected code is below for anyone else that needs this .

Cheers. Alex

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:\img\"
 Sub Sample()
     Dim ws As Worksheet
     Dim LastRow As Long, i As Long
     Dim strPath As String
     Dim FolderName As String
     
     With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        FolderName = .SelectedItems(1) & "\"
     End With
    
     '~~> 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
        If ws.Rows(i).Hidden = False Then
             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
        End If
     Next i
 End Sub