Copy specific files from 1 folder to anther based on a column in the worksheet

[biggatings]

Hi,
I have a worksheet that has about 4000 rows. Each of those rows is a product that I need to import into WooCommerce. In the Column AP is where the "image filenames" are stored. I have a folder that has about 10,000 images in it that I want just the ones in this workbook to be copied to a specific location.

Workbook1 - Column AP2..AP4000 contains filename.jpg
Source Folder - Contains 10,000 images (including the ones listed in wb1)
Destination Folder - Blank folder were I want the 4000 files to be copied to.

I have tried a few things but nothing seems to work. I am running Excel 19 on Mac.

 

[biggatings]

So this is what I have so far. In the Excel sheet I I have the Source in A1 and the Destination in A2. It runs without errors but it says 0 Files copied from Source folder to Destination folder.

Sub copy_specific_files_in_folder()
    
    Dim strSrc    As String
    Dim strDest   As String
    Dim strFile   As String
    Dim vRg       As Variant
    Dim vVal      As Variant
    Dim counter   As Long
    Const strExt  As String = ".jpg"
    
With ActiveWorkbook.ActiveSheet
        
        'Source path
        strSrc = .Range("A1")
        If strSrc = Empty Then
            MsgBox "No 'Source' path listed in cell A1", vbExclamation, "Invalid Entry"
            Application.Goto .Range("A1")
            Exit Sub
        End If
        If Dir(strSrc, vbDirectory) = "" Then
            MsgBox strSrc, vbExclamation, "Source Folder Does Not Exist"
            Application.Goto .Range("A1")
            Exit Sub
        End If
        If Right(strSrc, 1) <> "/" Then strSrc = strSrc & "/"
        
        'Destination path
        strDest = .Range("A2")
        If strDest = Empty Then
            MsgBox "No 'Destination' path listed in cell A2", vbExclamation, "Invalid Entry"
            Application.Goto .Range("A2")
            Exit Sub
        End If
       ' If Dir(strDest, vbDirectory) = "" Then
       '     MsgBox strDest, vbExclamation, "Destination Folder Does Not Exist"
       '     Application.Goto .Range("A2")
       '     Exit Sub
       ' End If
        If Right(strDest, 1) <> "/" Then strDest = strDest & "/"
        
        'delete existing files in destination folder
        strFile = Dir(strDest & "*" & strExt)
        Do While strFile <> ""
            Kill strDest & strFile
            strFile = Dir
        Loop
        
        'Copy file list
        vRg = .Range("B1:B3649").Value
        For Each vVal In vRg
            If vVal <> Empty Then
                If Dir(strSrc & vVal & strExt) <> "" Then 'if file exists
                    FileCopy strSrc & vVal & strExt, strDest & vVal & strExt
                    counter = counter + 1
                End If
            End If
        Next
    
    End With
    
    MsgBox "From: " & vbCr & strSrc & vbCr & vbCr & _
           "To:" & vbCr & strDest, vbInformation, _
           counter & " files have been copied."
    
End Sub

 

[VBA learner ITG]

When writing VBA for use on MAC operating system works differently to Windows operating system machine.

This website will help you especially as a mac user.

Copy file | Mac Excel Automation

Copy file or files with VBA in Mac Excel or use SaveCopyAs to save a copy of your workbook.

macexcel.com