Ошибка переполнения 6 при обработке определенных файлов в папке

Я хотел получить список в Excel всех моих фотографий с некоторыми exif-данными (дата съемки, марка камеры и модель).

Я запустил его для своей папки, содержащей около 3000 файлов, и он отлично подошел для 1796 из них.

Я прокомментировал "возобновление ошибки дальше", чтобы увидеть, что происходит.

Я получил ошибку 6 переполнение в этой строке:

objExif.Load objFile.Path

Если я переместил уже обработанные изображения из папки, макрос сразу выдает ошибки при проверке оставшихся. Если я запускаю макрос для уже обработанных изображений в новой папке, никаких ошибок не возникает.

Это приводит к выводу, что в обоих наборах картинок есть что-то другое, но я ничего не вижу. Оба набора являются цифровыми фотографиями, неотредактированными, с действительными данными exif.

Я надеюсь, что кто-то может помочь мне?

Код:

Private objFSO As Object, objTopFolder As Object, objSubFolder As Object, objFile As Object
Private i As Long
Private objExif As New ExifReader

Sub GetFiles()

    On Error Resume Next

    i = 2
    Worksheets("Filelist").Range("A2:G5000").Value = ""
    Worksheets("Paths").Range("A2:A5000").Value = ""
    Worksheets("Data").Range("E15:E5000").Value = ""

    If Sheets("Data").Range("B2").Value <> "" Then Call Filelist(Sheets("Data").Range("B2").Value, Sheets("Data").Range("C2").Value)
    If Sheets("Data").Range("B3").Value <> "" Then Call Filelist(Sheets("Data").Range("B3").Value, Sheets("Data").Range("C3").Value)
    If Sheets("Data").Range("B4").Value <> "" Then Call Filelist(Sheets("Data").Range("B4").Value, Sheets("Data").Range("C4").Value)
    If Sheets("Data").Range("B5").Value <> "" Then Call Filelist(Sheets("Data").Range("B5").Value, Sheets("Data").Range("C5").Value)
    If Sheets("Data").Range("B6").Value <> "" Then Call Filelist(Sheets("Data").Range("B6").Value, Sheets("Data").Range("C6").Value)
    If Sheets("Data").Range("B7").Value <> "" Then Call Filelist(Sheets("Data").Range("B7").Value, Sheets("Data").Range("C7").Value)
    If Sheets("Data").Range("B8").Value <> "" Then Call Filelist(Sheets("Data").Range("B8").Value, Sheets("Data").Range("C8").Value)
    If Sheets("Data").Range("B9").Value <> "" Then Call Filelist(Sheets("Data").Range("B9").Value, Sheets("Data").Range("C9").Value)
    If Sheets("Data").Range("B10").Value <> "" Then Call Filelist(Sheets("Data").Range("B10").Value, Sheets("Data").Range("C10").Value)
    If Sheets("Data").Range("B11").Value <> "" Then Call Filelist(Sheets("Data").Range("B11").Value, Sheets("Data").Range("C11").Value)

    Sheets("Filelist").Range("G1:G10000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Data").Range("E15"), Unique:=True
    Sheets("Filelist").Range("B2").Select
End Sub

Sub Filelist(TopFolder As String, includesub As String)
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objTopFolder = objFSO.GetFolder(TopFolder)
    If includesub = "yes" Then
        Call RecursiveFolder(objTopFolder, True)
    Else
        Call RecursiveFolder(objTopFolder, False)
    End If
End Sub

Sub RecursiveFolder(objFolder As Scripting.Folder, IncludeSubFolders As Boolean)
    For Each objFile In objFolder.Files
        If Right(objFile.Name, 3) = "jpg" Or Right(objFile.Name, 3) = "JPG" Then
            objExif.Load objFile.Path
            txtDate = objExif.Tag(DateTimeOriginal)
            txtmake = objExif.Tag(Make)
            txtmodel = objExif.Tag(Model)
            Worksheets("Filelist").Cells(i, 1) = objFile.Path
            Worksheets("Paths").Cells(i, 1) = objFile.Path
            Worksheets("Filelist").Cells(i, 2) = objFile.Name
            Worksheets("Filelist").Cells(i, 3) = txtDate
            Worksheets("Filelist").Cells(i, 4) = txtmake
            Worksheets("Filelist").Cells(i, 5) = txtmodel
            Worksheets("Filelist").Cells(i, 7) = Left(txtDate, 4)
            i = i + 1
        End If
    Next objFile

    If IncludeSubFolders Then
        For Each objSubFolder In objFolder.SubFolders
            Call RecursiveFolder(objSubFolder, True)
        Next objSubFolder
    End If
End Sub
Источник

1 ответ

Хорошо, нашел его после еще нескольких копаний.

Я переместил оператор "on error" в другую подпрограмму (ту, которая фактически выполняет всю работу), чтобы при ошибке загружался следующий файл, а не пропускал подпрограмму полностью.

Все файлы, кроме одного, были обработаны.

Этот файл оказался поврежден.

Private objFSO As Object, objTopFolder As Object, objSubFolder As Object, objFile As Object
Private i As Long
Private objExif As New ExifReader

Sub GetFiles()
    i = 2
    Worksheets("Filelist").Range("A2:G5000").Value = ""
    Worksheets("Paths").Range("A2:A5000").Value = ""
    Worksheets("Data").Range("E15:E5000").Value = ""

    If Sheets("Data").Range("B2").Value <> "" Then Call Filelist(Sheets("Data").Range("B2").Value, Sheets("Data").Range("C2").Value)
    If Sheets("Data").Range("B3").Value <> "" Then Call Filelist(Sheets("Data").Range("B3").Value, Sheets("Data").Range("C3").Value)
    If Sheets("Data").Range("B4").Value <> "" Then Call Filelist(Sheets("Data").Range("B4").Value, Sheets("Data").Range("C4").Value)
    If Sheets("Data").Range("B5").Value <> "" Then Call Filelist(Sheets("Data").Range("B5").Value, Sheets("Data").Range("C5").Value)
    If Sheets("Data").Range("B6").Value <> "" Then Call Filelist(Sheets("Data").Range("B6").Value, Sheets("Data").Range("C6").Value)
    If Sheets("Data").Range("B7").Value <> "" Then Call Filelist(Sheets("Data").Range("B7").Value, Sheets("Data").Range("C7").Value)
    If Sheets("Data").Range("B8").Value <> "" Then Call Filelist(Sheets("Data").Range("B8").Value, Sheets("Data").Range("C8").Value)
    If Sheets("Data").Range("B9").Value <> "" Then Call Filelist(Sheets("Data").Range("B9").Value, Sheets("Data").Range("C9").Value)
    If Sheets("Data").Range("B10").Value <> "" Then Call Filelist(Sheets("Data").Range("B10").Value, Sheets("Data").Range("C10").Value)
    If Sheets("Data").Range("B11").Value <> "" Then Call Filelist(Sheets("Data").Range("B11").Value, Sheets("Data").Range("C11").Value)

    Sheets("Filelist").Range("G1:G10000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Data").Range("E15"), Unique:=True
    Sheets("Filelist").Range("B2").Select
End Sub

Sub Filelist(TopFolder As String, includesub As String)
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objTopFolder = objFSO.GetFolder(TopFolder)
    If includesub = "yes" Then
        Call RecursiveFolder(objTopFolder, True)
    Else
        Call RecursiveFolder(objTopFolder, False)
    End If
End Sub

Sub RecursiveFolder(objFolder As Scripting.Folder, IncludeSubFolders As Boolean)
    On Error Resume Next
    For Each objFile In objFolder.Files
        If Right(objFile.Name, 3) = "jpg" Or Right(objFile.Name, 3) = "JPG" Then
            objExif.Load objFile.Path
            txtDate = objExif.Tag(DateTimeOriginal)
            txtmake = objExif.Tag(Make)
            txtmodel = objExif.Tag(Model)
            Worksheets("Filelist").Cells(i, 1) = objFile.Path
            Worksheets("Paths").Cells(i, 1) = objFile.Path
            Worksheets("Filelist").Cells(i, 2) = objFile.Name
            Worksheets("Filelist").Cells(i, 3) = txtDate
            Worksheets("Filelist").Cells(i, 4) = txtmake
            Worksheets("Filelist").Cells(i, 5) = txtmodel
            Worksheets("Filelist").Cells(i, 7) = Left(txtDate, 4)
            i = i + 1
        End If
    Next objFile

    If IncludeSubFolders Then
        For Each objSubFolder In objFolder.SubFolders
            Call RecursiveFolder(objSubFolder, True)
        Next objSubFolder
    End If
End Sub
Источник
Другие вопросы по тегам