FileSystem Object, Folder.Files.Count Does Not Match Files.Item Count

Excel Experts,

I realize the subject of this post is not tied directly to Excel but I have encountered it while working in an Excel project and hoping due to the volume of participation in this forum that someone else might have experienced the phenomenon and have a solution.


A few years ago I put together a project using the FileSystemObject that would create a list in Word or Excel of what I "thought" were all files in a folder and subfolders. Recently, I was informed that process was sometimes not returning 100% of the files and was painfully too slow for practical use dealing with very large folders.


In my attempt to determine why all files were listed, I stumbled upon the subject of this post. There are situations when the FileSystemObject will return a file count that matches the actual number of files in a folder, but the IFilesCollection of that folder does not match as the following illustrates.

Attachment 20177

As best I can tell, the issue is related to deep nested subfolders. I assume this because if I move the problematic folder to a different location with a shorter path, the file count and item count then match.

Here is my code:

Code:

---

Sub Test()
Dim strFile As String
Dim oFSO As Object
Dim oFile As Object
Dim oFolder As Object
Dim lngIndex As Long
  Dim strFolder As String
  strFolder = "D:\My Documents\Word\Word Documents\Word Tips\Macros\Word FAQ Pages and Code\Customization\Templates\How to create a template that makes it easy for users to fill in the blanks, without doing any programming_files\FillinTheBlanksContent_files"
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  Set oFolder = oFSO.GetFolder(strFolder)
  Debug.Print oFolder.Files.Count
  For Each oFile In oFolder.Files
    Debug.Print oFile.Name
  Next
End Sub

---

If I move the folder "FillinTheBlanksContent_files" to the root of my D:\ drive this problem goes away.

Anyone else seen this or know of a way to ensure the FileSystemObject with faithfully return "ALL" files?

Thanks.

In front of Item 1, item2, etc you find a + you can click on.

When subfolders are involved I'd prefer

Code:

---

Sub M_snb()
  msgbox createobject("wscript.shell").exec("cmd /c dir G:\OF\*.* /b/s/a-d").stdout.readall
End Sub

---

Expanding upon the wonderful one-liner

Code:

---

Const strFolder = "D:\My Documents\Word\Word Documents\Word Tips\Macros\Word FAQ Pages and Code\Customization\Templates\How to create a template that makes it easy for users to fill in the blanks, without doing any programming_files\FillinTheBlanksContent_files"


Sub M_snb1()
  Dim Lst
  Lst = CreateObject("wscript.shell").exec("cmd /c dir " & strFolder & "*.* /b/s/a-d").stdout.readall
  Lst = Split(Lst, vbLf)
  Cells(1, 1).Resize(UBound(Lst)) = Application.Transpose(Lst)
  Cells(1, 2) = UBound(Lst)
End Sub

---

@mdmackillp

You might be disappointed; you'd better use:

Code:

---

Const strFolder = "D:\My Documents\Word\Word Documents\Word Tips\Macros\Word FAQ Pages and Code\Customization\Templates\How to create a template that makes it easy for users to fill in the blanks, without doing any programming_files\FillinTheBlanksContent_files\"

Sub M_snb1()
  sn = split(CreateObject("wscript.shell").exec("cmd /c dir """ & strFolder & "*.*"" /b/s/a-d").stdout.readall,vbcrLf)
  Cells(1, 1).Resize(UBound(sn)) = Application.Transpose(sn)
  Cells(1, 2) = UBound(sn)
End Sub

---

Since the foldernames contain spaces (which should be avoided anytime) the commandstring errors out.
We have to solve that by adding "" "" in the commandstring.
A foldername should always be ended by a backslash.

Quote:

---

You might be disappointed

---

Frequently frustrated but never disappointed!

snb,

Do you even read the posts? Or what is your point? Certainly I can find a + in front of each item and I can l click on them until the cows come home. That will not change the fact that there are 20 files in the folder but only 4 items.

You fancy message box is nice as well if one wanted a msgbox and one wanted to look at a command prompt. I don't. The question remains. FSO returns a count a 20 files in a folder but only returns 4 items. Do you know why or how to fix?

If you know a way to run your one liner but suppress the black command prompt from appearing then that solution would be very helpful, otherwise is it is just a sideshow.

mdmackillop,

Thanks. I am already using something similar to list all twenty files in Excel. I am not using the shell.exec because I have to avoid the command prompt that can sometimes show for several seconds or over a minute for very large folders.

Code:

---

Option Explicit
 Const strFolder = "D:\My Documents\Word\Word Documents\Word Tips\Macros\Word FAQ Pages and Code\Customization\Templates\How to create a template that makes it easy for users to fill in the blanks, without doing any programming_files\FillinTheBlanksContent_files\"
 Sub CreateFileList()
 Dim strPath As String
 Dim varFileList As Variant
 Dim lngIndex As Long
 Dim lngCounter As Long
 Dim lngPosit As Long
 Dim oWB As Workbook
 Dim oSheet As Worksheet
 Dim varTemp
  strPath = strFolder 'Change to suit.
varFileList = fcnGetList(strPath, 1)
  If UBound(varFileList) = -1 Then GoTo lbl_Exit
  ReDim varTemp(1 To UBound(varFileList) + 1, 1 To 2)
  For lngIndex = LBound(varFileList) To UBound(varFileList)
    If varFileList(lngIndex) <> "" Then
      lngCounter = lngCounter + 1
      lngPosit = InStrRev(varFileList(lngIndex), "\")
      'Lists files in first column/folders in second column.
      varTemp(lngCounter, 1) = Mid(varFileList(lngIndex), lngPosit + 1, Len(varFileList(lngIndex)))
      varTemp(lngCounter, 2) = Mid(varFileList(lngIndex), 1, lngPosit)
    End If
  Next lngIndex
  Set oWB = ThisWorkbook
  Set oSheet = oWB.Sheets(1)
  oSheet.Range("A1").Resize(lngCounter, UBound(varTemp, 2)).Value = varTemp
  oSheet.Sort.SortFields.Clear
  oSheet.Sort.SortFields.Add key:=oSheet.Range("A1"), SortOn:=0, Order:=1, DataOption:=0
  With oSheet.Sort
    .SetRange oSheet.UsedRange
    .Header = 1
    .MatchCase = False
    .Orientation = 1
    .SortMethod = 1
    .Apply
End With
  Application.Columns("A:B").EntireColumn.AutoFit
 lbl_Exit:
  Set oWB = Nothing: Set oSheet = Nothing
  Exit Sub
 End Sub
 Function fcnGetList(strFolder, lngRouter)
 Dim strOutPut As String
 Dim oShell, oFSO As Object
 Dim lngIndex As Long
 Dim varTemp
  If Not Right(strFolder, 1) = "\" Then strFolder = strFolder & "\"
  Set oShell = CreateObject("wscript.shell")
  'Note, I used this method to avoid the black command prompt that is displayed if Shell.Exec is used.
  Select Case lngRouter
    Case 1: oShell.Run "cmd /c Dir """ & strFolder & "*"" /a:-d/s/ogn/b > C:\FileListOut.txt", 0, 1
    Case 2: oShell.Run "cmd /c Dir """ & strFolder & "*"" /a:-d/ogn/b > C:\FileListOut.txt", 0, 1
  End Select
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  With oFSO
    strOutPut = .OpenTextFile("C:\FileListOut.txt").ReadAll()
    .DeleteFile "C:\FileListOut.txt"
  End With
  If Right(strOutPut, 1) = Chr(10) Then strOutPut = Left(strOutPut, Len(strOutPut) - 1)
  varTemp = Split(strOutPut, vbCrLf)
  If lngRouter = 2 Then
    For lngIndex = 0 To UBound(varTemp)
      varTemp(lngIndex) = strFolder & varTemp(lngIndex)
    Next lngIndex
  End If
  fcnGetList = varTemp
 lbl_Exit:
  Set oShell = Nothing: Set oFSO = Nothing
  Exit Function
 End Function
 Public Function fcnFileOrFolderExist(PathName As String) As Boolean
 Dim lngTemp As Long
  On Error Resume Next
  lngTemp = GetAttr(PathName)
  Select Case Err.Number
    Case Is = 0: fcnFileOrFolderExist = True
  Case Else
    fcnFileOrFolderExist = False
  End Select
  On Error GoTo 0
 lbl_Exit:
  Exit Function
 End Function

---

The problem is, after I get the list of files in that manner, the user may need to get the attributes for one or more (all) of the listed files. The code for that:

Code:

---

Sub FillInFileDetails()
Dim oSheet As Worksheet
Dim oRow As Range
Dim oFSO As Object
Dim oFile As Object
Dim lngCount As Long
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  Set oSheet = ActiveSheet
  lngCount = 0
  On Error GoTo Err_File
  For Each oRow In oSheet.Rows
    If oSheet.Cells(oRow.Row, 1).Value = "" Then Exit For
    lngCount = lngCount + 1
    Set oFile = oFSO.GetFile(oSheet.Cells(lngCount, 2) & oSheet.Cells(lngCount, 1))
    With oSheet
      .Cells(lngCount, 3).Value = oFile.DateCreated
      .Cells(lngCount, 4).Value = oFile.DateLastAccessed
      .Cells(lngCount, 5).Value = oFile.DateLastModified
      .Cells(lngCount, 6).Value = oFile.Size
      .Cells(lngCount, 7).Value = oFile.Type
    End With
Err_ReEntry:
    DoEvents
  Next oRow
  On Error GoTo 0
lbl_Exit:
  Exit Sub
Err_File:
  oSheet.Cells(lngCount, 3).Value = "Error accessing file"
  Resume Err_ReEntry
End Sub

---

For the particular folder (even though there are 20 files) and the Folder count returns 20 as my picture illustrates, there are only four items! Thanks.

Quote:

---

If you know a way to run your one liner but suppress the black command prompt from appearing then that solution would be very helpful, otherwise is it is just a sideshow.

---

I like the way you project your fears onto others.
And yes I know the method to suppress the DOS-box: it runs even faster that way.
But it's no use as long as basics as avoiding spaces in foldernames are apparently unknown territory.

snb,

"I like the way you project your fears onto others." What rabbit hole did you pull that from?

I think you and I have crossed breakers before and thought we had reached an agreement that when you see one of my post and have nothing positive to contribute that you would simply ignore it. Since your first reply was completely unrelated to the question asked and here you simply want to be argumentative, I am now firmly convinced that you are just one of those who, like little children in kindergarten, thrive on gold stars by your name and your primary objective here is post count.

You might find this hard to imagine, but I have very little control over what others might choose to name their files or folders and I am in no position to scold them when I am given a hard drive to investigate, and really can't just hand it back.

I have no doubt that you have a far greater mastery of DOS, the scripting shell and probably computers in general than I ever will and perhaps you are matchless among all other mortals. However, your taunt that you know something that I don't know is perfectly childish. I don't think you do know. So put up or shut up.

Edit:

Concur with Zach and apologize to the members of this forum for my part in this pointless, unproductive dialog with snb.

Let's just lay down the blanket statement below, bestowed upon me once by a wise person. It's universal, and I'll keep it as close to the source quote as I can. I'm not pointing fingers, but merely emphasizing standard moral behavior.

Quote:

---

If you don't have anything nice to say, don't say anything at all.

---

Be nice. Nuff said.

Solved.

The issue with Files collection missing one more files is apparently related to the file path exceeding 260 characters (regardless if the path contains offending spaces or not) and can be resolved as shown:

Code:

---

Sub FillInFileDetails()
    Dim oSheet As Worksheet
    Dim oRow As Range
    Dim oFSO As Object
    Dim oFile As Object
    Dim oFolder as Object
    Dim lngCount As Long
    Dim strPath as String
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oSheet = ActiveSheet
    lngCount = 0
    On Error GoTo Err_File
    For Each oRow In oSheet.Rows
        If oSheet.Cells(oRow.Row, 1).Value = "" Then Exit For
        lngCount = lngCount + 1
        strPath = oSheet.Cells(lngCount, 2) & oSheet.Cells(lngCount, 1))
        If Len(strPath) > 259 Then
          Set oFolder = oFSO.GetFolder(oSheet.Cells(lngCount, 2))
          strPath = oFolder.Shortpath & "\" & oSheet.Cells(lngCount, 1)
        End If
        Set oFile = oFSO.GetFile(strPath)
        With oSheet
            .Cells(lngCount, 3).Value = oFile.DateCreated
            .Cells(lngCount, 4).Value = oFile.DateLastAccessed
            .Cells(lngCount, 5).Value = oFile.DateLastModified
            .Cells(lngCount, 6).Value = oFile.Size
            .Cells(lngCount, 7).Value = oFile.Type
        End With
Err_ReEntry:
        DoEvents
    Next oRow
    On Error GoTo 0
lbl_Exit:
    Exit Sub
Err_File:
    oSheet.Cells(lngCount, 3).Value = "Error accessing file"
    Resume Err_ReEntry
End Sub

---