遍历JPG文件，如何跳过“拒绝的权限”

ning84

1. Sub ll()
   
2.     Dim Sht As Worksheet, Rng As Range
   
3.         Set Sht = Sheet1
   
4.         Set Sht = Sheet1
   
5.         Sht.Cells.Clear
   
6.         Sht.Cells.Font.Size = 9
   
7.         Set Rng = Sht.Cells(1, 2)
   
8.         TraverserJPG Rng, "D:"
   
9. End Sub
   
10. 
    
11. Function TraverserJPG(Rng As Range, FolderPath)
    
12.    ''
    
13.     'Debug.Print Rng.Address
    
14.         ''
    
15.     Dim FSO As Scripting.FileSystemObject
    
16.     Dim oFile As File, oFilesAs As Files
    
17.     Dim oFolder As Folder
    
18.     Dim Img As WIA.ImageFile
    
19.     Dim oDate As Date
    
20.     Dim Rr, Cc
    
21.     Dim Str
    
22.    
    
23.         Set Img = New WIA.ImageFile
    
24.         ''
    
25.         Rr = Rng.Row + 2
    
26.         Cc = 1
    
27.         Set FSO = New Scripting.FileSystemObject
    
28.         Set oFolder = FSO.GetFolder(FolderPath)
    
29.         ''
    
30.         For Each oFile In oFolder.Files
    
31.             '
    
32.             With Rng
    
33.                If InStr(oFile.Name, "JPG") > 0 Then
    
34.                    Img.LoadFile oFile.Path
    
35.                    Debug.Print Rng(Rr, 1).Address, Rng.Parent.Name,
    
36.                    Rng(Rr, 1) = oFile.Name
    
37.                    Debug.Print oFile.Name, oFile.Path
    
38.                    Rng(Rr, 2) = oFile.DateLastModified
    
39.                    Rng(Rr, 3) = Img.Width
    
40.                    Rng(Rr, 4) = Img.Height
    
41.                    Rng(Rr, 5) = Format(Int(oFile.Size / 1024), "0,000")
    
42.                    Rng(Rr, 6) = ThisWorkbook.Path & "" & oFile.Name
    
43.                    Rr = Rr + 1
    
44.                End If
    
45.             End With
    
46.         Next oFile
    
47.         ''
    
48.         For Each oFolder In oFolder.SubFolders
    
49.              TraverserJPG Rng(Rr, 1), oFolder.Path
    
50.         Next oFolder
    
51. End Function
    
52. ''
    
53. 
    
54. 
    

复制代码

ning84

用Dir方法遍历JPG文件，解决问题。

1. 
   
2. 
   
3. Sub TraveJPGinDisk()
   
4.     Dim Img As WIA.ImageFile
   
5.         Set Img = New WIA.ImageFile
   
6.     Dim Fso As Scripting.FileSystemObject
   
7.         Set Fso = New Scripting.FileSystemObject
   
8.     Dim oFile As File
   
9.     With Sheet2.Cells
   
10.          .Clear
    
11.          .Font.Size = 8
    
12.          .ColumnWidth = 5
    
13.     End With
    
14.     With Sheet3.Cells
    
15.           .Clear
    
16.           .Font.Size = 8
    
17.           .ColumnWidth = 6
    
18.     End With
    
19.     Dim MyName, MyFileName
    
20.     Dim Ke, ii, Cc
    
21.     T = Time
    
22.     Dim Dic As Dictionary, Did As Dictionary
    
23.     Set Dic = New Dictionary
    
24.     Set Did = New Dictionary
    
25.     Dic.Add ("D:"), ""
    
26.     i = 0
    
27.     Do While i < Dic.Count
    
28.         Ke = Dic.Keys
    
29.         MyName = Dir(Ke(i), vbDirectory)    '查找目录
    
30.         Do While MyName <> ""
    
31.             If MyName <> "." And MyName <> ".." Then
    
32.                 If (GetAttr(Ke(i) & MyName) And vbDirectory) = vbDirectory Then
    
33.                     Dic.Add (Ke(i) & MyName & ""), ""
    
34.                 End If
    
35.             End If
    
36.             MyName = Dir
    
37.         Loop
    
38.         i = i + 1
    
39.     Loop
    
40.     ii = 5
    
41.     For Each Ke In Dic.Keys
    
42.          'Debug.Print Ke
    
43.          Sheet3.Cells(ii, 3) = Ke
    
44.          ii = ii + 1
    
45.     Next Ke
    
46.    
    
47.     For Each Ke In Dic.Keys
    
48.         MyFileName = Dir(Ke & "*.JPG")
    
49.         Do While MyFileName <> ""
    
50.             Did.Add (Ke & MyFileName), ""
    
51.             MyFileName = Dir
    
52.         Loop
    
53.     Next
    
54.     ii = 5
    
55.     Cc = 1
    
56.     For Each Ke In Did.Keys
    
57.           With Sheet2
    
58.               If InStr(Ke, ":") > 0 Then
    
59.                   Set oFile = Fso.GetFile(Ke)
    
60.                   'Debug.Print oFile.Name
    
61.                   Img.LoadFile Ke
    
62.                   Debug.Print oFile.DateLastModified
    
63.                   .Cells(ii, Cc + 1) = oFile.Name
    
64.                   .Cells(ii, Cc + 2) = Img.Width
    
65.                   .Cells(ii, Cc + 3) = Img.Height
    
66.                   .Cells(ii, Cc + 4) = Format(oFile.Size, "0,000")
    
67.                   .Cells(ii, Cc + 5) = oFile.DateLastModified
    
68.                   .Cells(ii, Cc + 10) = Ke
    
69.                   ii = ii + 1
    
70.               End If
    
71.           End With
    
72.     Next Ke
    
73.    
    
74.     TT = Time - T
    
75.     Debug.Print Minute(TT) & "分" & Second(TT) & "秒"
    
76. End Sub

复制代码