copying images from one folder and pasting in another based on schedule in excel file

Hi guys
Hope you all well and safe from Covid. while in lockdown im hoping someone can assist me with this query.
i had a macro created whereby image product code is listed in Column A, Column B lists the location of that particular image and Column C displays the location of where i want those images to be copied to. the code for that particular file is listed below. what i need help with if possible is can additional product images codes be listed in the exact same cell separated by ";". ive attached a sample file of what i would like done (it contains the old code as well)

Code:

---

Sub copylistfile()
oldpath = Range("B2")
newpath = Range("C2")
LR = Cells(Rows.Count, "A").End(xlUp).Row
For r = 2 To LR
  pc = Cells(r, 1)
  fn = Dir(oldpath & pc & ".jpg")
  If fn <> "" Then
    FileCopy oldpath & pc & ".jpg", newpath & pc & ".jpg"
    Cells(r, 4) = "copied"
  Else
    Cells(r, 4) = "missing"
    Cells(r, 4).Interior.ColorIndex = 3
  End If
Next
End Sub

---

Code:

---

Sub copylistfile_1()
    Dim oldpath    As String
    Dim newpath    As String
    Dim LR          As Long
    Dim pc          As Variant
    Dim r          As Long
    Dim i          As Long
    Dim strResp    As String
    Dim fn          As String


    LR = Cells(Rows.Count, "A").End(xlUp).Row


    If LR = 1 Then Exit Sub


    For r = 2 To LR
        oldpath = Cells(r, "B")
        newpath = Cells(r, "C")


        pc = Split(Cells(r, 1).Value, ";")


        strResp = vbNullString


        For i = 0 To UBound(pc)


            fn = Dir(oldpath & pc(i) & ".jpg")


            If fn <> "" Then
                FileCopy oldpath & pc(i) & ".jpg", newpath & pc & ".jpg"
                strResp = strResp & "C" & ";"
            Else
                strResp = strResp & "M" & ";"
            End If


        Next i


        If Len(strResp) > 0 Then
            strResp = Left(strResp, Len(strResp) - 1)
            Cells(r, 4) = strResp
            If InStr(1, strResp, "M", vbTextCompare) > 0 Then
                Cells(r, 4).Interior.ColorIndex = 3
            End If
        End If


    Next r


End Sub

---

where the letters in column D mean:
(C)opied; (M)issing

Artik

Doest seem to be working Artik
can it be such that the image type shoud be searched by the image name and not the file type. some of the images are in PNG format also so the easiest would be for the criteria to choose the image name.
ive added the above code in an excel file based in the "images" folder on the C:/
nothing seems to be copying to the "Copied" folder on the C:/
am i doing something wrong?
refer to the excel file of the original post. i only changed the macro script to your code above. is there something else that i need to do?

Quote:

---

Originally Posted by merQrey

ive added the above code in an excel file based in the "images" folder on the C:/
nothing seems to be copying to the "Copied" folder on the C:/
am i doing something wrong?

---

Ouch, I made a mistake. The relevant line should look like this:

Code:

---

FileCopy oldpath & pc(i) & ".jpg", newpath & pc(i) & ".jpg"

---

Quote:

---

Originally Posted by merQrey

can it be such that the image type shoud be searched by the image name and not the file type. some of the images are in PNG format also so the easiest would be for the criteria to choose the image name.

---

Replace the code snippet with the following

Code:

---

        For i = 0 To UBound(pc)

            fn = Dir(oldpath & pc(i) & ".*")

            If fn <> "" Then
                FileCopy oldpath & fn, newpath & fn
                strResp = strResp & "C" & ";"
            Else
                strResp = strResp & "M" & ";"
            End If

        Next i

---

Artik

Thank you kindly Artik :D this totally worked. you are truly a champion!!!