文件搜索在VBA [英] File searching in VBA

问题描述

我写了一个vba代码，浏览所有路径文件夹并搜索strings.xml文件。

  Dim oFS As Office.FileSearch 
 Dim i As Integer 
设置oFS = Application.FileSearch 
 
带有oFS 
 .NewSearch 
 .FileType = msoFileTypeAllFiles 
。 Filename =strings.xml
 .LookIn =D：\Workspace
 .SearchSubFolders = True 
 .Execute 
 
 MsgBoxFinish！&发现文件找到了！ 
结束
  

但是，在我的工作区我有很多strings.xml文件这个当前的代码定位，但我只想在特定子文件夹中找到strings.xml;例如 ./ values / strings.xml 文件

解决方案

在 Values\Strings.xml 的根工作文件夹下递归地查找，并将其列在 Scripting.Dictionary 对象。

主文件/文件夹搜索由简单的目录功能。

  Sub dir_ValuesStringsXML_list（）
 Dim f As Long，ff As String，fp As String，fn As String，tmp As String 
 Dim vfn As变量，dFILE作为对象'new scripting_dictionary 
 
设置dFILEs = CreateObject（Scripting.Dictionary）
 dFILEs.CompareMode = vbTextCompare 
 
'为c设置vars： \temp\Workspace\ * * \Values\Strings.xml 
 fp = Environ（TMP）& Chr（92）& Workspace
 ff =值
 fn =Strings.xml
 dFILEs.Item（fp）= 0 
 
'获取文件夹列表
 do 
f = dFILEs.Count 
对于每个vfn在dFILEs 
如果不是CBool​​（dFILEs.Item（vfn））然后
 
 tmp = Dir（vfn& Chr（92）& Chr（42），vbDirectory）
 Do While CBool​​（Len（tmp））
如果不是CBool​​（InStr（1，tmp，Chr（46）））Then 
 dFILEs.Item（vfn& Chr（92）& tmp）= 0 
 End If 
 tmp = Dir 
 Loop 
'Debug.Print dFILEs.Count 
 dFILEs.Item（vfn）= 1 
 End If 
下一个vfn 
循环直到f = dFILEs.Count 
 
'删除文件夹并检查Values\ strings.xml 
对于每个vfn在dFILEs 
如果CBool​​（dFILEs.Item（vfn））然后
如果LCase（Split（vfn，Chr（92））（UBound（S plit（vfn，Chr（92）））））= LCase（ff）和_ 
 CBool​​（Len（Dir（vfn& Chr（92）& fn，vbReadOnly + vbHidden + vbSystem）））然后
 dFILEs.Item（vfn& Chr（92）& fn）= 0 
 End If 
 dFILEs.Remove vfn 
结束如果
下一个vfn 
 
'列出文件
对于每个vfn在dFILEs 
 Debug.Printfrom dict：& vfn 
下一个vfn 
 
 dFILEs.RemoveAll：设置dFILEs = Nothing 
 
 End Sub 
  

---

_{如果您希望将Scripting.Dictionary的后期绑定转换为早期绑定，则必须添加 VB.NET的工具►参考资料。href =https://msdn.microsoft.com/en-us/library/hww8txat.aspx =nofollow> Microsoft Scripting Runtime sub>}

I wrote a vba code that browse all path folder and search for "strings.xml" file.

Dim oFS As Office.FileSearch
Dim i As Integer
Set oFS = Application.FileSearch

With oFS
    .NewSearch
    .FileType = msoFileTypeAllFiles
    .Filename = "strings.xml"
    .LookIn = "D:\Workspace"
    .SearchSubFolders = True
    .Execute

    MsgBox "Finish ! " & .FoundFiles.Count & " item found !"
End With

However, in my workspace I have many "strings.xml" files that this current code locates and but I only want to find the "strings.xml" within a specific subfolder; e.g. ./values/strings.xml files.

解决方案

The following will look recursively under your root working folder for Values\Strings.xml matches and list them in a Scripting.Dictionary object.

The main file/folder search is performed by the simple Dir function.

Sub dir_ValuesStringsXML_list()
    Dim f As Long, ff As String, fp As String, fn As String, tmp As String
    Dim vfn As Variant, dFILEs As Object    'New scripting_dictionary

    Set dFILEs = CreateObject("Scripting.Dictionary")
    dFILEs.CompareMode = vbTextCompare

    'set vars for c:\temp\Workspace\*\Values\Strings.xml
    fp = Environ("TMP") & Chr(92) & "Workspace"
    ff = "Values"
    fn = "Strings.xml"
    dFILEs.Item(fp) = 0

    'get folder list
    Do
        f = dFILEs.Count
        For Each vfn In dFILEs
            If Not CBool(dFILEs.Item(vfn)) Then

                tmp = Dir(vfn & Chr(92) & Chr(42), vbDirectory)
                Do While CBool(Len(tmp))
                    If Not CBool(InStr(1, tmp, Chr(46))) Then
                        dFILEs.Item(vfn & Chr(92) & tmp) = 0
                    End If
                    tmp = Dir
                Loop
                'Debug.Print dFILEs.Count
                dFILEs.Item(vfn) = 1
            End If
        Next vfn
    Loop Until f = dFILEs.Count

    'remove the folders and check for Values\Strings.xml
    For Each vfn In dFILEs
        If CBool(dFILEs.Item(vfn)) Then
            If LCase(Split(vfn, Chr(92))(UBound(Split(vfn, Chr(92))))) = LCase(ff) And _
               CBool(Len(Dir(vfn & Chr(92) & fn, vbReadOnly + vbHidden + vbSystem))) Then
                dFILEs.Item(vfn & Chr(92) & fn) = 0
            End If
            dFILEs.Remove vfn
        End If
    Next vfn

    'list the files
    For Each vfn In dFILEs
        Debug.Print "from dict: " & vfn
    Next vfn

    dFILEs.RemoveAll: Set dFILEs = Nothing

End Sub

---

_{If you wish to convert the late binding of the Scripting.Dictionary to early binding, you must add Microsoft Scripting Runtime to the VBE's Tools ► References.}

这篇关于文件搜索在VBA的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！