PDA

View Full Version : [SOLVED] FileSystem Object, Folder.Files.Count Does Not Match Files.Item Count



gmaxey
08-25-2017, 05:41 AM
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.

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:


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.

snb
08-25-2017, 05:44 AM
In front of Item 1, item2, etc you find a + you can click on.

When subfolders are involved I'd prefer


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

mdmackillop
08-25-2017, 06:08 AM
Expanding upon the wonderful one-liner

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

snb
08-25-2017, 06:41 AM
@mdmackillp

You might be disappointed; you'd better use:



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.

mdmackillop
08-25-2017, 06:54 AM
You might be disappointed
Frequently frustrated but never disappointed!

gmaxey
08-25-2017, 08:37 AM
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.

gmaxey
08-25-2017, 08:51 AM
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.


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:



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.

snb
08-25-2017, 10:20 AM
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.

gmaxey
08-25-2017, 12:22 PM
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.

Zack Barresse
08-25-2017, 04:33 PM
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.


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

Be nice. Nuff said.

gmaxey
08-25-2017, 05:43 PM
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:


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