Как добавить проверку ошибок в мой макрос копирования файлов VBA?

Question

Я пытаюсь добавить обработку ошибок к этому. В основном этот код просматривает исходную папку, содержащую 15000 изображений JPEG, и сравнивает ее со столбцом A и копирует имена файлов, перечисленные в столбце A, из A1 в целевую папку, и это работает, но у меня нет обработки ошибок. Было бы неплохо знать, какие файлы не копируются, потому что они имеют неправильные имена, поэтому я могу исправить дыры в моих данных.

Есть ли способ добавить проверку ошибок и сделать ее ячейки красными? если файл изображения в исходном пути не существует?

Sub test()
Dim r As Range
Dim sourcepath As String, destpath As String, fname As String
sourcepath = "C:\Users\paul\Desktop\CONVERTED TIFS\"
destpath = "c:\test2\"


For Each r In Range("A1", Range("A" & Rows.Count).End(xlUp))
    fname = Dir(sourcepath & r)
    Do While fname <> ""
        FileCopy sourcepath & fname, destpath & fname
        fname = Dir()
Loop
Next

End Sub

Answer 1

Вы можете сделать что-то вроде этого:

Sub test()

    Dim r As Range
    Dim sourcepath As String, destpath As String, fname As String

    sourcepath = "C:\Users\paul\Desktop\CONVERTED TIFS\"
    destpath = "c:\test2\"

    For Each r In Range("A1", Range("A" & Rows.Count).End(xlUp))
        If len(r.value) > 0 then
            fname = Dir(sourcepath & r.Value)

            If Len(fname) > 0 Then
                r.Interior.Color = vbGreen
                r.offset(0, 1).Value = "Copied"
                FileCopy sourcepath & fname, destpath & fname
            Else
                r.Interior.Color = vbRed
                r.offset(0, 1).Value = "Not found"
            End If

        End If
    Next

End Sub

Настройте смещение, если вы хотите поместить трекинг в другой столбец.