Sub ts()

    Dim oDLG
    Dim pth As String
    Dim Flname As String
    
    Dim shl As Shell32.Shell
    Dim shfd As Shell32.Folder
    Dim s As String
    Dim i As Integer
    
    Set oDLG = CreateObject("MSComDlg.CommonDialog")
    
    With oDLG
            
            .DialogTitle = "打开文件"
            .Filter = "所有文件|*.*"
            .MaxFileSize = 255
            .ShowOpen
            If .Filename <> "" Then
                
                i = InStrRev(.Filename,"\")
                If i = 0 Then Exit Sub
                Flname = Mid(.Filename,i + 1)
                Set shl = New Shell
                Set shfd = shl.Namespace(Left(.Filename,i - 1))

            For i = 0 To 39
            
                If shfd.GetDetailsOf(0,i) <> "" And shfd.GetDetailsOf(shfd.Items.Item(Flname),i) <> "" Then
                    
                    s = s & i & ":" & shfd.GetDetailsOf(0,i) & ": " & shfd.GetDetailsOf(shfd.Items.Item(Flname),i) & Chr(10)
                    Debug.Print s
                    
                End If
                
            Next i
            
            MsgBox s,vbInformation,"文件属性"
            
        End If
        
    End With
    
    Set oDLG = Nothing
    
End Sub

先引用Microsoft Shell Controls and Automation

VBA实例

Sub ts()

    Dim pth As String
    Dim Flname As String
    Dim sPath As String
    Dim sOwner As String
    
    Dim shl As Shell32.Shell
    Dim shfd As Shell32.Folder
    Dim s As String
    Dim i As Integer
    
    sPath = "\\10.116.0.26\smc82files\06、公用文件\"
    Flname = Dir(sPath)
    
    i = 2
    
    Do While Flname <> ""
    
        If Flname <> "." And Flname <> ".." Then
    
            If GetAttr(sPath & Flname) = vbDirectory Then
            
                Flname = Dir()
                
            Else
            
                Set shl = New Shell
                Set shfd = shl.Namespace(sPath)
                ActiveSheet.Cells(i,1).Value = Flname
                ActiveSheet.Cells(i,2).Value = shfd.GetDetailsOf(shfd.Items.Item(Flname),10)
                ActiveSheet.Cells(i,3).Value = shfd.GetDetailsOf(shfd.Items.Item(Flname),20)
                i = i + 1
                Flname = Dir()
                
            End If
            
        Else
        
            Flname = Dir()
            
        End If
            
    Loop
    
    MsgBox "ok"
                
End Sub