Problems with Excel returning .FoundFiles = 0

[pcfuqua]

In the code below (and in several previous variations of) I keep getting a value of 0 for .Execute and .FoundFiles. I have had several experiences where it has correctly returned the number of files in the folder one day, and zero the next, even though there have always been files in the folder. The code returns the correct folder name so I know it is searching in the correct location, it just doesn't see the files that I know are there. Why don't I consistently get the correct number of files returned?

Sub Execute_Table_Load()

Dim File_Path As String
Dim Folder_Path As String
Dim i as Integer
Dim Document_List As String
Dim docName as String
Dim fs As FileSearch

File_Path = ThisWorkbook.Path

'Build a path to the folder where the word documents are:
Folder_Path = File_Path & "\Test"

Set fs = Application.FileSearch
With fs
.NewSearch
.LookIn = Folder_Path
.SearchSubFolders = False
.FileType = msoFileTypeWordDocuments

If .Execute > 0 Then

Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True

For i = 1 To .FoundFiles.Count

Set wrdDoc = wrdApp.Documents.Open(.FoundFiles(i))
docName = Left(wrdDoc.Name, Len(wrdDoc.Name) - 4)
'rest of code goes here
Document_List = Document_List & vbNewLine & docName

Next i

MsgBox "Data from these files were extracted:" & vbNewLine & Document_List
wrdApp.Quit 'close the Word application

Else

MsgBox "No Documents were found in folder: " & Folder_Path

End If

Set wrdApp = Nothing 'Explicitly clear memory

End With

End Sub

 

[Kenneth Hobson]

Mine does that too but it makes no difference.

Here is an example using the DIR method. Since I prefer early binding methods, you will need to add the reference as I commented in the Function.

Sub GetMyFiles()
  Dim myFolder As String, wcFiles As String, s() As Variant
  'Input parameters
  myFolder = "x:\MsWord" 'No trailing backslash
  wcFiles = "*.doc"
  s = MyFiles(myFolder, wcFiles)
  'Check to see if s() has any filenames
  If s(0) = "NA" Then Exit Sub
  
  'Put the contents of s() into column A
  Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(UBound(s) + 1).Value _
    = WorksheetFunction.Transpose(s)  
End Sub

Function MyFiles(myFolder As String, wcFiles As String) As Variant
'Requires reference to Microsoft Scripting Runtime
  Dim cFiles As New Scripting.Dictionary
  Dim FileName As String, a() As Variant
  
  'Put filenames into dictionary
  FileName = myFolder & "\" & Dir(wcFiles)
  Do While FileName <> myFolder & "\"
    cFiles.Add FileName, FileName
    FileName = myFolder & "\" & Dir
  Loop
  
  'Return keys or items as an array
  If cFiles.Count > 0 Then
    a = cFiles.Keys
    MyFiles = a
    Else
    ReDim a(1) As Variant
    a(0) = "NA"
    MyFiles = a
  End If
  Set cFiles = Nothing
End Function

 

[tresa123]

Mine does that too but it makes no difference.

Here is an example using the DIR method. Since I prefer early binding methods, you will need to add the reference as I commented in the Function.

Sub GetMyFiles()
  Dim myFolder As String, wcFiles As String, s() As Variant
  'Input parameters
  myFolder = "x:\MsWord" 'No trailing backslash
  wcFiles = "*.doc"
  s = MyFiles(myFolder, wcFiles)
  'Check to see if s() has any filenames
  If s(0) = "NA" Then Exit Sub
  
  'Put the contents of s() into column A
  Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(UBound(s) + 1).Value _
    = WorksheetFunction.Transpose(s)  
End Sub

Function MyFiles(myFolder As String, wcFiles As String) As Variant
'Requires reference to Microsoft Scripting Runtime
  Dim cFiles As New Scripting.Dictionary
  Dim FileName As String, a() As Variant
  
  'Put filenames into dictionary
  FileName = myFolder & "\" & Dir(wcFiles)
  Do While FileName <> myFolder & "\"
    cFiles.Add FileName, FileName
    FileName = myFolder & "\" & Dir
  Loop
  
  'Return keys or items as an array
  If cFiles.Count > 0 Then
    a = cFiles.Keys
    MyFiles = a
    Else
    ReDim a(1) As Variant
    a(0) = "NA"
    MyFiles = a
  End If
  Set cFiles = Nothing
End Function

Hi all,

I am facing the same problem as posted on this post. Has a solution been found for the same?

Does using the DIR method work?

Thanks,
Tresa

 

[BrianB]

Keep it simple to begin with.

'=============================================================================
'- SIMPLE DIR
'=============================================================================
Sub test()
    Dim MyPath As String
    Dim MyFile As String
    '------------------------------------------------------------------------
    MyPath = ThisWorkbook.path & "\"
    MyFile = Dir(MyPath & "*.xls")   ' filter .xls files
    '------------------------------------------------------------------------
    '- LOOP through files in folder
    Do While MyFile <> ""
        MsgBox (MyFile)
        MyFile = Dir    ' Get next file
    Loop
    '------------------------------------------------------------------------
End Sub
'=============================================================================

 

[pcfuqua]

Here is a chunk of code that I have used numerous times to open and process excel files. It seems to work very well for how I am using it:

Public Sub Process_Files_In_User_Specified_Folder()
 
    Dim oBook As Workbook
    Dim Summary_Book As Workbook
    Dim sPath As String
    Dim sFileSpec As String
    Dim sFile As String
    Dim sFileList() As String
    Dim counter As Integer
 
    ' Give active workbook a variable name
    Set Summary_Book = ActiveWorkbook
 
    ' Get Folder name to process
    sPath = InputBox("Enter Folder to Process", "Batch", "")
 
    ' Exit sub if nothing entered or cancel button is selected
    If sPath = "" Then Exit Sub
 
    ' Append backslash is none exists at end of file folder
    If Right(sPath, 1) <> "\" Then
         sPath = sPath & "\"
    End If
 
    ' Add excel extension type to search for and open
    sFileSpec = sPath & "*.xls"
 
    ' Get All filenames in the Folder
    sFile = Dir$(sFileSpec)
 
    ' Create counter for array of filenames
    counter = 0
 
    ' Build array of filenames
    Do Until sFile = ""
        counter = counter + 1
        ReDim Preserve sFileList(counter) As String
        sFileList(counter) = sFile
        sFile = Dir$
    Loop
 
    ' Process each file
    For counter = 1 To UBound(sFileList)
 
        'Open each file
        Set oBook = Excel.Workbooks.Open(sPath & sFileList(counter))
 
 
        ' Process each newly opened file here
 
 
        ' Close each file
        oBook.Close savechanges:=False
        Set oBook = Nothing
 
    Next counter
 
    ' Release dynamic array
    Erase sFileList
 
    MsgBox ("Macro Complete")
End Sub