counting excel files in a folder

  • Thread starter Thread starter dstiefe
  • Start date Start date
One way is to use DIR with a loop....

Sub Macro()
Dim strFolder As String, strFile As String
Dim intCount As Integer
strFolder = "d:\"
strFile = Dir(strFolder & "*.xls", vbNormal)
Do While strFile <> ""
intCount = intCount + 1
strFile = Dir
Loop
MsgBox intCount & " files found"
End Sub
 
Here is another method

Sub test()
folder = "c:\temp"

Set FS = Application.FileSearch
With FS
.NewSearch
.LookIn = folder
.SearchSubFolders = False
'.Filename = "Run"
'.MatchTextExactly = True
.FileType = msoFileTypeExcelWorkbooks

FileCount = .Execute

If FileCount > 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
Else
MsgBox "There were no files found."
End If

End With


End Sub
 
This is how you can do it with the Windows API.
Haven't tested, but might be the fastest way.

Option Explicit

Private Const vbDot = 46
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const vbBackslash = "\"
Private Const ALL_FILES = "*.*"

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Private Declare Function FindClose Lib "kernel32" _
(ByVal hFindFile As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" _
Alias "FindFirstFileA" _
(ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA)
As Long
Private Declare Function FindNextFile Lib "kernel32" _
Alias "FindNextFileA" _
(ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA) As
Long
Private Declare Function lstrlen Lib "kernel32" _
Alias "lstrlenW" (ByVal lpString As Long)
As Long

Function CountFilesInFolder(sRoot As String, _
strFile As String) As Long

Dim WFD As WIN32_FIND_DATA
Dim hFile As Long
Dim strFileName As String

hFile = FindFirstFile(sRoot & ALL_FILES, WFD)

If hFile <> INVALID_HANDLE_VALUE Then
Do
'if a folder call method again
If (WFD.dwFileAttributes And vbDirectory) Then
If Asc(WFD.cFileName) <> vbDot Then
'--------------------
'DEALING WITH FOLDERS
'--------------------
CountFilesInFolder _
sRoot & TrimNull(WFD.cFileName) & vbBackslash, _
strFile
End If
Else
'------------------
'DEALING WITH FILES
'------------------
strFileName = TrimNull(WFD.cFileName)
If strFileName Like strFile Then
CountFilesInFolder = CountFilesInFolder + 1
End If
End If
Loop While FindNextFile(hFile, WFD)
End If

FindClose hFile

End Function

Function TrimNull(strString As String) As String
TrimNull = Left$(strString, lstrlen(StrPtr(strString)))
End Function


RBS
 
dies this work inexcel 2007

when i do this ittells me that "Object doesn't support this action"

any ideas?
 
Back
Top