处理文件夹中的某些文件时发生溢出错误6

我想在我的所有照片excel中列出一些exif数据(拍摄date,相机制作和型号)。

我把它运行在大约3000个文件的文件夹中,1796个文件就完美了。

我评论了“在错误恢复下一步”看看是怎么回事。

这条线上有一个错误6溢出:

objExif.Load objFile.Path 

如果将已处理的图像移出文件夹,则在检查剩余的图像时,将立即出现macros观错误。 如果我对新文件夹中的已处理图片运行macros,则不会引发错误。

这导致了这样的结论:两套图画都有不同的东西,但是我看不到任何东西。 这两套都是数码照片,未经编辑,有效的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 

好的,经过一些挖掘后发现它。

我把“错误”语句移到了不同​​的子类(实际上完成所有工作的子类),所以如果错误,下一个文件被加载,而不是完全跳过子。

现在除了一个以外的所有文件都被处理。

那一个文件竟然被损坏了。

 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