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