jkluio668
5/8/2018 - 10:13 AM

os_walk1

遍历文件夹

Function os_walk1(fp)
    Dim MyName, Dic, Did, i, t, F, TT, MyFileName
'    Dim objshell
'    Dim objfolder
    Dim ke, sh
'    Set objshell = CreateObject("Shell.Application")
'    Set objfolder = objshell.BrowseForFolder(0, "选择文件夹", 0, 0)
'    If Not objfolder Is Nothing Then fp = objfolder.self.Path & "\"
'    Set objfolder = Nothing
'    Set objshell = Nothing
    
'    fp = ThisWorkbook.Path & "\"
    Set Dic = CreateObject("Scripting.Dictionary")    '创建一个字典对象
    Set Did = CreateObject("Scripting.Dictionary")
    Dic.Add (fp), ""
    i = 0
    Do While i < Dic.count
        ke = Dic.keys   '开始遍历字典
        MyName = Dir(ke(i), vbDirectory)    '查找目录
        Do While MyName <> ""
            If MyName <> "." And MyName <> ".." Then
                If (GetAttr(ke(i) & MyName) And vbDirectory) = vbDirectory Then    '如果是次级目录
                    Dic.Add (ke(i) & MyName & "\"), ""  '就往字典中添加这个次级目录名作为一个条目
                End If
            End If
            MyName = Dir    '继续遍历寻找
        Loop
        i = i + 1
    Loop
    Did.Add ("文件清单"), ""    '以查找D盘下所有EXCEL文件为例
    For Each ke In Dic.keys
        MyFileName = Dir(ke & "*.*")
        Do While MyFileName <> ""
            Did.Add (ke & MyFileName), ""
            MyFileName = Dir
        Loop
    Next
'    os_walk1 = Join(Did.keys, Chr(13))
    os_walk1 = Did.keys
End Function


使用 GetAttr 函数来得知文件及目录或文件夹的属性。 'Dim MyAttr
' 假设 TESTFILE 具有隐含属性。
MyAttr = GetAttr("TESTFILE")   ' 返回 2。' 如果 TESTFILE 有隐含属性,则返回非零值。
Debug.Print MyAttr And vbHidden   ' 假设 TESTFILE 具有隐含的只读属性。
MyAttr = GetAttr("TESTFILE")   ' 返回 3 。' 如果 TESTFILE 含有隐含属性,则返回非零值。
Debug.Print MyAttr And (vbHidden + vbReadOnly)   ' 假设 MYDIR 代表一目录或文件夹。
MyAttr = GetAttr("MYDIR")   ' 返回 16。