VBA loop through directory, store names

[BigLRIP]

Hi all,

I'm looking for a VBA function that will loop through a directory, and store every *.pub file into an array. I want each value in the array to be the full path to the *.pub file, not just the name.

In Office 2003 I used to do the following, but .FileSearch does not work in office 2007:

Sub GrabTextFromDashboards(DBPath As String, TXTPath As String)
    
    Application.ScreenUpdating = False
    
    Dim intCount As Integer
    Dim arrFiles() As String
    Dim arrFileNames() As String
    Dim strPath, strName, strFilePath As String
    Dim strWriteup As String
    Dim lngPathLen As Long
 
    strPath = DBPath
    lngPathLen = Len(strPath)

    With Application.FileSearch
           .NewSearch
           .FileName = "*.pub"
           .LookIn = strPath
           .Execute
        
           For intCount = 1 To .FoundFiles.Count
           Next intCount
        
           ReDim arrFiles(1 To intCount) As String
           ReDim arrFileNames(1 To intCount) As String
        
           '********** Stores the path of all files into an Array
           For intCount = 1 To .FoundFiles.Count
               arrFiles(intCount) = .FoundFiles(intCount)
           Next intCount
           .
           .
           .

 

[VoG]

You should be able to use DIR. Example

Sub ListFiles()
Dim MyFolder As String
Dim MyFile As String
Dim j As Integer
MyFolder = "C:\example"
MyFile = Dir(MyFolder & "\*.xls")
Do While MyFile <> ""
    j = j + 1
    Cells(j, 1).Value = MyFile
    MyFile = Dir
Loop
End Sub

 

[BigLRIP]

Thanks VoG!

now I have

Dim MyFile As String
    Dim j As Integer
    j = 0
    MyFile = Dir(strPath & "\*.pub")
    Do While MyFile <> ""
        j = j + 1
        MyFile = Dir
    Loop
    
    ReDim arrFiles(1 To j) As String
    ReDim arrFileNames(1 To j) As String
    
    Dim k As Integer
    k = 1
    MyFile = Dir(strPath & "\*.pub")
    Do While MyFile <> ""
        arrFiles(k) = strPath & "\" & MyFile
        k = k + 1
        MyFile = Dir
    Loop

Any idea why my array fails to store the last file in the directory?

 

[BigLRIP]

nevermind, just had to change

j = 0

to

j = 1

 

[VoG]

A guess: Change Do While to Do Until.

 

[Jon von der Heyden]

You don't need to loop through the directory twice, e.g:

Dim arrFiles
Dim MyFile As String
Dim j As Long
j = 0

MyFile = Dir(strpath & "\*.pub")

Do While Len(MyFile) > 0
    MyFile = Dir
    ReDim Preserve arrFiles(j)
    arrFiles(j) = strpath & "\" & MyFile
    j = j + 1
Loop