Count all "xlsx" fromat files in a Folder

[K]

Hi all, I am working in Excel 2007 and I want macro to count all
"xlsx" fromat files in a folder and put that total count number in
Range("A1"). I found macro (see below) but I am getting error message
on line "With Application.FileSearch" saying "Run-time error 445 -
Object doesn't support this action" Please can any friend can help me
on this.

Sub test()
Dim foldername As String
foldername = "C:\Data"
    With Application.FileSearch
        .NewSearch
        .LookIn = foldername
        .SearchSubFolders = False
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute() > 0 Then
            MsgBox .FoundFiles.Count & " Excel files were found"
        Else
            MsgBox "There were no files found."
        End If
    End With
End Sub

 

[Bob Phillips]

FileSearch has been dropped for Excel 2007.

Try

Sub test()
Dim foldername As String
Dim FSO As Object
Dim fldr As Object
Dim file As Object
Dim cnt As Long

foldername = "C:\Data"
Set FSO = CreateObject("Scripting.FilesystemObject")
Set fldr = FSO.GetFolder(foldername)
For Each file In fldr.Files

If file.Type Like "*Microsoft Office Excel*" Then

cnt = cnt + 1
End If
Next file

Set file = Nothing
Set fldr = Nothing
Set FSO = Nothing

Range("A1").Value = cnt
End Sub



--
__________________________________
HTH

Bob

Hi all, I am working in Excel 2007 and I want macro to count all
"xlsx" fromat files in a folder and put that total count number in
Range("A1"). I found macro (see below) but I am getting error message
on line "With Application.FileSearch" saying "Run-time error 445 -
Object doesn't support this action" Please can any friend can help me
on this.

Sub test()
Dim foldername As String
foldername = "C:\Data"
With Application.FileSearch
..NewSearch
..LookIn = foldername
..SearchSubFolders = False
..FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
MsgBox .FoundFiles.Count & " Excel files were found"
Else
MsgBox "There were no files found."
End If
End With
End Sub

 

[JMay]

xl2007 dropped .FileSearch from its Library << it is not available
That's all i can tell you; sorry

 

[K]

xl2007 dropped .FileSearch from its Library << it is not available
That's all i can tell you; sorry






- Show quoted text -

Thanks lot bob

 

[K]

Just small question with you bob that at the moment your code is
counting all excel files in a folder. But how can i specify it to
just count "xlsx" excel format files in folder.

 

[JMay]

Bob, how would one search by extension type, say for example -- only .xlsm ?

 

[Bob Phillips]

Change

If file.Type Like "*Microsoft Office Excel*" Then

to

If file.Type Like "*Microsoft Office Excel W*" Then

 

[Bob Phillips]

Like so

Sub test()
Dim foldername As String
Dim FSO As Object
Dim fldr As Object
Dim file As Object
Dim cnt As Long

foldername = "C:\Data"
Set FSO = CreateObject("Scripting.FilesystemObject")
Set fldr = FSO.GetFolder(foldername)
For Each file In fldr.Files

If Mid$(file.Name, InStrRev(file.Name, ".") + 1) = "xlsm" Then

cnt = cnt + 1
End If
Next file

Set file = Nothing
Set fldr = Nothing
Set FSO = Nothing

Range("A1").Value = cnt
End Sub

 

[K]

Like so

Sub test()
Dim foldername As String
Dim FSO As Object
Dim fldr As Object
Dim file As Object
Dim cnt As Long

    foldername = "C:\Data"
    Set FSO = CreateObject("Scripting.FilesystemObject")
    Set fldr = FSO.GetFolder(foldername)
    For Each file In fldr.Files

        If Mid$(file.Name, InStrRev(file.Name, ".") + 1) = "xlsm" Then

            cnt = cnt + 1
        End If
    Next file

    Set file = Nothing
    Set fldr = Nothing
    Set FSO = Nothing

    Range("A1").Value = cnt
End Sub

--
__________________________________
HTH

Bob







- Show quoted text -

Thanks again Bob for all your help and time

 

[Dave Peterson]

One way:

Option Explicit
Sub test()
Dim foldername As String
Dim FSO As Object
Dim fldr As Object
Dim file As Object
Dim cnt As Long


foldername = "C:\Data"

Set FSO = CreateObject("Scripting.FilesystemObject")
Set fldr = FSO.GetFolder(foldername)
For Each file In fldr.Files
If LCase(file.Name) Like "*.xlsx" Then
cnt = cnt + 1
End If
Next file

Set file = Nothing
Set fldr = Nothing
Set FSO = Nothing

Range("A1").Value = cnt
End Sub

 

[JMay]

Thanks Bob;
FWIW:
Last Comment - When comparing the Count (in Cell A1) to my actual 2007 Data
files, I found the code to produce 1 greater than the actual count. Had to
(on last line) use Range("A1").Value = cnt - 1

 

[K]

One way:

Option Explicit
Sub test()
    Dim foldername As String
    Dim FSO As Object
    Dim fldr As Object
    Dim file As Object
    Dim cnt As Long

    foldername = "C:\Data"

    Set FSO = CreateObject("Scripting.FilesystemObject")
    Set fldr = FSO.GetFolder(foldername)
    For Each file In fldr.Files
        If LCase(file.Name) Like "*.xlsx" Then
            cnt = cnt + 1
        End If
    Next file

    Set file = Nothing
    Set fldr = Nothing
    Set FSO = Nothing

    Range("A1").Value = cnt
End Sub

Thanks Dave for you help

 

[Jenga Linden]

Hi Bob-

I have a similar problem, except my Excel 2003 macro used to loop
through files in a folder and run a macro on them (like an update file
macro or something). Now I cannot run that and I have been trying
extremely hard to figure a way around it but I'm completely
lost...here's my old code, any help from anyone please would help

Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook

With Application.FileSearch
.NewSearch
'Insert path to folder with files to update below
.LookIn = "C:\Documents and Settings\Jennifer
Sturgill\Desktop\ERCI-JS Offline\JUNE VPM MACRO Defender
Files\TESTFILES"
.FileType = msoFileTypeExcelWorkbooks
'.Filename = "Book*.xls"
If .Execute > 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all.
'Open Workbook x and Set a Workbook variable to it
Set wbResults =
Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
Application.Run "PERSONAL.xls!VPM_BudgetUpdates2"
Next lCount
End If
End With

On Error GoTo 0


THANKS! J


*** Sent via Developersdex http://www.developersdex.com ***