求大神帮忙把2个宏组合成一个

yukiru

1. Sub 读取文件()
   
2.   Dim oShell As Object
   
3.   Dim oFile As Object
   
4.   Dim oFldr As Object
   
5.   Dim lRow As Long
   
6.   Dim iCol As Integer
   
7.   Dim vArray As Variant
   
8.   vArray = Array(0, 10, 18, 176)
   
9.   Set oShell = CreateObject("Shell.Application")
   
10.   lRow = 1
    
11.       Set oFldr = oShell.Namespace(<span style="background-color: red;">*引用【Private Sub GetFiles】内的文件夹和子文件夹路径*</span>)
    
12.       With oFldr
    
13.         For iCol = LBound(vArray) To UBound(vArray)
    
14.           Cells(lRow, iCol + 1) = .getdetailsof(.Items, vArray(iCol))
    
15.         Next iCol
    
16.         For Each oFile In .Items
    
17.           lRow = lRow + 1
    
18.           For iCol = LBound(vArray) To UBound(vArray)
    
19.           On Error Resume Next
    
20.             Cells(lRow, iCol + 1) = .getdetailsof(oFile, vArray(iCol))
    
21.           Next iCol
    
22.         Next oFile
    
23.       End With
    
24. End Sub

复制代码

Private Sub GetFiles(ByVal sPath$, ByVal sFileType$, ByRef Fso As Object, ByRef arr$(), ByRef m&)

    Dim Folder As Object
    Dim SubFolder As Object
    Dim File As Object
    Set Folder = Fso.GetFolder(sPath)
    For Each File In Folder.Files
        If File.Name Like sFileType Then
            If File.Name <> ThisWorkbook.Name Then
                m = m + 1
                ReDim Preserve arr(1 To 2, 1 To m)
                arr(1, m) = sPath & "\"
                arr(2, m) = File.Name
            End If
        End If
    Next
    If Folder.SubFolders.Count > 0 Then
        For Each SubFolder In Folder.SubFolders
            Call GetFiles(SubFolder.Path, sFileType, Fso, arr, m)
        Next
    End If
    Set Folder = Nothing
    Set File = Nothing
    Set SubFolder = Nothing
End Sub

需要是读取当前文件夹和子文件夹内的【jpg】格式图片属性（所有者，尺寸等），路径不是固定的需要是把excel放置到运行路径内

yukiru

有高手吗…