Search for files in VBA

I wrote vba code that looks through the entire path folder and looks for the file "strings.xml".

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 finds, but I just want to find "strings.xml" in a specific subfolder; e.g. ./values/strings.xml .

+4
source share
3 answers

Below you will see recursively in your working folder for the roots Values\Strings.xml and list them in the Scripting.Dictionary object.

Basic file / folder searches are performed using 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 want to convert the late binding of Scripting.Dictionary to early binding, you must add the Microsoft Scripting Runtime to VBE Tools ► Links.

+1
source

I think you say that you want to look in the subfolder "\ values" for files named strings.xms

If this is correct, try the code below:

 Dim oFS As Office.FileSearch Dim i As Integer Set oFS = Application.FileSearch With oFS .NewSearch .FileType = msoFileTypeAllFiles .Filename = "strings.xml" .LookIn = "D:\Workspace\values" .SearchSubFolders = True .Execute MsgBox "Finish ! " & .FoundFiles.Count & " item found !" End With 

Of course, you can omit the subfolder.

Here is another option:

 Dim sPath As String Dim sFil As String Dim strName As String sPath = "D:\Workspace\values" 'Change Path sFil = Dir(sPath & "string.xml") 'All files in Directory matching name Do While sFil <> "" strName = sPath & sFil sFil = Dir 'Your Code Here. i=i+1 Loop MsgBox "Finish ! " & .FoundFiles.Count & " item found !" 

Have you considered using FileSystemObject for recursive searches in only a subfolder?

MSDN - how to do a recursive search using FileSystemObject

NTN

Philip

0
source

replace:

 sPath = "D:\Workspace\values" 'Change Path sFil = Dir(sPath & "string.xml") 'All files in Directory matching name 

with:

 sPath = "D:\Workspace\values\" 'Change Path sFil = Dir(sPath & "*.xl*") 'All files in Directory matching name 
0
source

All Articles