Renaming images and moving to a new folde VBA

[murrayjl03]

Hi there,

I hope you can help me, I have found similar scenarios but nothing that fits my needs and I'm too new to VBA to work it out.

I have thousands of images currently in random folders fom my suppliers. I am wanting to rename all these images and then move to another folder in a different location.

Ideally I would create an excel like this;

Original image location	SKU	Image renamed to	Add to location
C:folder1	SKU123456	Size12-Large-Mens-Hoodie	C:newfolder1
C:folder2	SKU567890	Size12-Large-Mens-Hoodie-Red	C:newfolder2

Step 1 would be to rename the images. Within folder 1, there will be around 25 images so i would want iterations of the renaming to be "Size12-Large-Mens-Hoodie-1", "Size12-Large-Mens-Hoodie-2" etc. Ideally, it would do it in order, so the first image in the folder would become '1'.

Apart from that, I would create all of the details in the table above.

If anyone can help me out, it would seriously be appriciated.

Thanks,

Jess

 

[John_w]

This macro renames each folder's files and moves them to the new folder in one step. Test it on just one sheet row by deleting row 3 in your example.

Public Sub Rename_and_Move_Files()

    Dim sourceFolder As String, destFolder As String, fileName As String
    Dim r As Long, n As Long, p As Long
    
    With ActiveSheet
        For r = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            sourceFolder = .Cells(r, "A").Value
            If Right(sourceFolder, 1) <> "\" Then sourceFolder = sourceFolder & "\"
            destFolder = .Cells(r, "D").Value
            If Right(destFolder, 1) <> "\" Then destFolder = destFolder & "\"
            n = 0
            fileName = Dir(sourceFolder & "*.*")
            While fileName <> vbNullString
                n = n + 1
                p = InStrRev(fileName, ".")
                Name sourceFolder & fileName As destFolder & .Cells(r, "C").Value & "-" & n & Mid(fileName, p)
                fileName = Dir
            Wend
        Next
    End With
    
    MsgBox "Done"
    
End Sub