加入收藏 | 设为首页 | 会员中心 | 我要投稿 李大同 (https://www.lidatong.com.cn/)- 科技、建站、经验、云计算、5G、大数据,站长网!
当前位置: 首页 > 百科 > 正文

获取文件属性中详细信息里的各项目(vb 学习备注)

发布时间:2020-12-17 08:20:31 所属栏目:百科 来源:网络整理
导读: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 = "
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.26smc82files6、公用文件"
    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

(编辑:李大同)

【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容!

    推荐文章
      热点阅读