Office Excel VBA-实现文件检索

朋友要在Excel里做个功能，指定用VBA，能够模糊查找某文件夹下的特定文件及其路径。文件夹下可能存在文件包含特殊字符或者无法打开等异常。

因为完全没有学过VBA，所以这是个快餐代码。。。功能是差不多OK，但没有系统测试过，而且里面各种写死图方便，全是技术债。

朋友说要个窗体，后面再说，但技术债肯定是懒得改了。

供参考。

Sub 矩形1_Click()
Dim MyName, Dic, Did, I
    On Error GoTo ERR_1
    Range("B3:B10000").ClearContents
    Range("D1:D10000").ClearContents
    Range("F1:F10000").ClearContents
    Ddh11 = LCase(Range("B2"))

    Set Dic = CreateObject("Scripting.Dictionary")    '创建一个字典对象

    Set Did = CreateObject("Scripting.Dictionary")

    Dic.Add (Range("b1")), ""   '遍历寻找地址

    I = 0
    J = 3   '从B3开始写正常结果
    K = 1   '特殊字符的文件，从D1开始写

    Do While I < Dic.Count
        ke = Dic.keys   '开始遍历字典

        MyName = Dir(ke(I), vbDirectory)    '查找目录

        Do While MyName <> ""
        Dim name As String
        name = MyName
        flag = CheckFolderName(name)

        If flag And MyName <> "." And MyName <> ".." Then

            If (GetAttr(ke(I) & MyName) And vbDirectory) = vbDirectory Then    '如果是次级目录

                Dic.Add (ke(I) & MyName & "\"), ""  '就往字典中添加这个次级目录名作为一个条目

            End If

            If LCase(MyName) Like "*" & Ddh11 & "*" Then     '打开所在文件夹

                ddddz = "explorer " & ke(I) & MyName
                cell = "B" + Trim(Str(J))
                Range(cell).Select
                ActiveCell.FormulaR1C1 = ke(I) & MyName
                J = J + 1
                
                'Shell ddddz, vbNormalFocus ‘这是打开文件夹/文件的代码

                'Exit Sub

            End If
        ElseIf Not flag Then
            If MyName <> "" Then
                cell = "D" + Trim(Str(K))
                Range(cell).Select
                ActiveCell.FormulaR1C1 = ke(I) & MyName
                K = K + 1
            End If
        End If

        MyName = Dir    '继续遍历寻找

    Loop

    I = I + 1

    Loop


ERR_1:
    If MyName <> "" Then
        Range("F1").Select
        ActiveCell.FormulaR1C1 = ke(I) & MyName
    End If

End Sub

Public Function CheckFolderName(FolderName As String) As Boolean
    Dim lngLen As Long
    CheckFolderName = True
    lngLen = Len(FolderName)
    If (Len(Replace(FolderName, "\", "")) <> lngLen) Then CheckFolderName = False
    If (Len(Replace(FolderName, "/", "")) <> lngLen) Then CheckFolderName = False
    If (Len(Replace(FolderName, ":", "")) <> lngLen) Then CheckFolderName = False
    If (Len(Replace(FolderName, "*", "")) <> lngLen) Then CheckFolderName = False
    If (Len(Replace(FolderName, "?", "")) <> lngLen) Then CheckFolderName = False
    If (Len(Replace(FolderName, "<", "")) <> lngLen) Then CheckFolderName = False
    If (Len(Replace(FolderName, ">", "")) <> lngLen) Then CheckFolderName = False
    If (Len(Replace(FolderName, "|", "")) <> lngLen) Then CheckFolderName = False
    If (Len(Replace(FolderName, """", "")) <> lngLen) Then CheckFolderName = False
End Function