Wrox Programmer Forums
Go Back   Wrox Programmer Forums > Microsoft Office > Excel VBA > Excel VBA
|
Excel VBA Discuss using VBA for Excel programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Excel VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
 
Old January 24th, 2011, 11:28 AM
Friend of Wrox
 
Join Date: Jan 2011
Posts: 103
Thanks: 7
Thanked 0 Times in 0 Posts
Default Counting files within sub folders

Hi

Does anyone know how to open all files within a folder and its subfolders and perform a counta and place the result into a workbook.

I have a piece of code which does this but for one folder without subfolders but i need to open a folder with sub folders

Can anyone help?

Thank you

Jeskit
 
Old January 24th, 2011, 11:52 AM
Friend of Wrox
 
Join Date: Sep 2010
Posts: 171
Thanks: 0
Thanked 14 Times in 14 Posts
Default

still at it huh jeskit, lol
Code:
Dim FS As Office.FileSearch
Dim vaFileName as Variant
Dim i as Long
Dim stMessage as String
Dim iCount as Long

Set FS = Application.FileSearch

With FS

'Clear old search criteria
.NewSearch

'Directory to search
.Lookin = "C:\MyFiles"

'Include subfolders in search
.SearchSubFolders = True

'Look for excel files
.FileType = msoFileTypeExcelWorkbooks

'Doesn't matter when last modified
.LastModified = msoLastModifiedAnyTime

'Carry out the search and capture the number of files found
iCount = .Execute

stMessage = Format(iCount, "0 ""Files found""")

'List the files in the FoundFiles collection
For Each vaFileName in .FoundFiles
   stMessage = stMessage & vbCr & vaFileName
Next vaFileName

MsgBox stMessage

End With
Try that
 
Old January 24th, 2011, 11:58 AM
Friend of Wrox
 
Join Date: Sep 2010
Posts: 171
Thanks: 0
Thanked 14 Times in 14 Posts
Default

you can also use the FileName property like so:
Code:
.FileName = "*.xls"
 
Old January 24th, 2011, 12:21 PM
Friend of Wrox
 
Join Date: Jan 2011
Posts: 103
Thanks: 7
Thanked 0 Times in 0 Posts
Default

Hi

Unfortunalty yes! It was finally done and now i have to change it so it opens One folder and does the count for every file in all the sub folders that are in it.

i was thinking i could put a loop around the loop that opens the file and performs the counta. But i am not sure how i am only a beginner when it comes to VBA! I am much better with HTML!

I added the code you sent but i think i added it in the wrong place

Code:
Sub Get_Dealer_Count()

'********************************************************************
'Opens the extract size checker document
'Loops through the Dealerdata folder
'Takes a count of all files in the folder
'Places the result into the extract size checker document
'JS - 17/01/2011
'********************************************************************

'Define Variables
    'Const strFldr As String = "Path2"
    Dim strTemplate As String
    Dim strFldr As String
    Dim strFile As String
    Dim FS  As Office.FileSearch
    Dim wbExtractSize As Workbook
    Dim wbCsv As Workbook
    Dim wsDealerExtracts As Worksheet
    Dim wsMyCsvSheet As Worksheet
    Dim lNextRow As Long

'set strFldr variables
    strFldr = "C:\Production2\ATX\Extracts\201001\"

'set strFile variables
    strFile = Dir(strFldr & "\*.csv")

'set the calculation mode
    Application.Calculation = xlCalculationManual

'set the workbook and worksheet
    Set wbExtractSize = Workbooks.Open("C:\Documents and Settings\SeymourJ\Desktop\Tasks\MacroTask\Extract_Size_Checker_test.xls")
    Set wsDealerExtracts = wbExtractSize.Sheets("Dealer Extracts")

'find the next row available in ExtractSize, add two to
    lNextRow = 18
   
'Loop through the csv files
    Set FS = Application.FileSearch
    With FS
    .NewSearch
    .SearchSubFolders = True
    .LastModified = msoLastModifiedAnyTime
    If Len(strFldr) > 0 Then
        Do
            Set wbCsv = Workbooks.Open(Filename:=strFldr & "\" & strFile)
            Set wsMyCsvSheet = wbCsv.Sheets(1)
            With wsDealerExtracts
                .Cells(lNextRow, 6) = strFldr
                .Cells(lNextRow, 7) = strFile
                .Cells(lNextRow, 8) = WorksheetFunction.CountA(wsMyCsvSheet.Range("A:A"))
            End With
        
        'increment to the next row
            lNextRow = lNextRow + 1
        
        'close it
            wbCsv.Close
        
        'go to next file
            strFile = Dir
            Application.StatusBar = strFile
        Loop Until Len(strFile) = 0
    End If
    End With
    
    ActiveWorkbook.ActiveSheet.Range("A1").Select
    
'clean up
    Set wbExtractSize = Nothing
    Set wbCsv = Nothing
    Set wsDealerExtracts = Nothing
    Set wsMyCsvSheet = Nothing

End Sub
Any Ideas?
 
Old January 24th, 2011, 12:23 PM
Friend of Wrox
 
Join Date: Jan 2011
Posts: 103
Thanks: 7
Thanked 0 Times in 0 Posts
Default

Just noticed you are using FileSearch but i am using 2010 and unfortunalty Microsoft have dropped that line of code in 2007 onwards! I found that out earlier as i tried to use that before!
 
Old January 24th, 2011, 01:09 PM
Friend of Wrox
 
Join Date: Sep 2010
Posts: 171
Thanks: 0
Thanked 14 Times in 14 Posts
Default

alright well here's some code that i used. you have to set a reference to VBScript in order to make it work: Hit Tools > References then scroll down and put a check next to Microsoft Scripting Runtime.

I have it set up as a class module, so what you'll need to do is right-click on the project explorer, then click 'Add class module', then name it "clsFileHandler". In your new class module, copy the following code:
Code:
'To use this class module in another workbook, you'll need to set a reference to the "microsoft scripting runtime" library
Option Explicit

Private FSO As Scripting.FileSystemObject

'For putting the file list into a worksheet
Private lTargetOffset As Long

Public Sub GetAllFiles(FolderPath As String, Target As Range) 'including those in sub folders
'gets all files in FolderPath, including those in subfolders
    Static oParentFolder As Scripting.Folder
    Static oSubFolder As Scripting.Folder
    Static oFolders As Scripting.Folders
    
    Set oParentFolder = FSO.GetFolder(FolderPath)
    Set oFolders = oParentFolder.SubFolders
    
    GetFileList FolderPath, Target
    
    If oFolders.Count = 0 Then 'there's no subfolders in this folder
        Exit Sub
    End If
    
    For Each oSubFolder In oFolders
        GetAllFiles oSubFolder.Path, Target
    Next
End Sub
Public Sub ClearPreviousSearch(shtSheet As Worksheet)
shtSheet.UsedRange.Offset(1, 0).EntireRow.Delete
lTargetOffset = 0
End Sub
Public Sub GetFileList(FolderToSearch As String, Target As Range) 'in current folder only, no sub folders
'this will put a list of files on a spreadsheet at the Target, does not include files in subfolders

Static oMainFolder As Scripting.Folder
Static oFileCollection As Scripting.Files
Static oFile As Scripting.File

'Put a trailing backslash on path if it's not there
If Right(FolderToSearch, 1) <> "\" Then
    FolderToSearch = FolderToSearch & "\"
End If

Set oMainFolder = FSO.GetFolder(FolderToSearch)
Set oFileCollection = oMainFolder.Files

For Each oFile In oFileCollection
'    'here's a few other properties you can return
'    oFile.Path
'    oFile.DateCreated
'    oFile.DateLastModified

'    'and a method
'    oFile.Delete
    Target.Offset(lTargetOffset, 0) = oFile.Path
    Target.Offset(lTargetOffset, 1) = oFile.Name
    lTargetOffset = lTargetOffset + 1
Next oFile

End Sub

Private Sub Class_Initialize()
Set FSO = New Scripting.FileSystemObject
End Sub

Private Sub Class_Terminate()
Set FSO = Nothing
End Sub
Then in your regular module, the one you're putting code into, put the following:
Code:
Dim FH As New clsFileHandler
FH.ClearPreviousSearch shtFiles
FH.GetAllFiles "C:\Users\Mike\Documents\Business\StatsCustomers1\CustomerWebsites\elizabethsloomroom", shtFiles.Range("A2")
Set FH = Nothing
Next, rename an extra worksheet as shtFiles. Now, you need to be careful here. You need to rename it in the VBE. Click on the sheet in the project explorer, then in the properties window at the top, you'll see "(Name)", do not confuse this with "Name" without the parantheses. Then change the folder path to whatever you want and test it
 
Old January 24th, 2011, 01:20 PM
Friend of Wrox
 
Join Date: Jan 2011
Posts: 103
Thanks: 7
Thanked 0 Times in 0 Posts
Default

Ok

Thanks i tried what you said and it highlighted
Code:
 FH As New clsFileHandler
and produced an error saying "User-Defined type not defined"
 
Old January 24th, 2011, 02:10 PM
Friend of Wrox
 
Join Date: Sep 2010
Posts: 171
Thanks: 0
Thanked 14 Times in 14 Posts
Default

you need to put that code, the LARGER block of code that starts off with "'To use this class module in another workbook, you'll need to set a reference to the "microsoft scripting runtime" library" into a CLASS module. Hit Insert > Class Module, then name it clsFileHandler, and then it should work
 
Old January 24th, 2011, 02:12 PM
Friend of Wrox
 
Join Date: Sep 2010
Posts: 171
Thanks: 0
Thanked 14 Times in 14 Posts
Default

and just to be sure, it's
Code:
Dim FH As New clsFileHandler

'not
FH As New clsFileHandler
 
Old January 25th, 2011, 04:37 AM
Friend of Wrox
 
Join Date: Jan 2011
Posts: 103
Thanks: 7
Thanked 0 Times in 0 Posts
Default

Hi

Ok i tried what you said and i got the same error but it highlighted this line instead:

Code:
 FSO As Scripting.FileSystemObject





Similar Threads
Thread Thread Starter Forum Replies Last Post
Files and Folders in VB.Net2008 kumar.selva.c Visual Basic 2008 Professionals 6 September 26th, 2011 12:58 PM
Authenticating Specific Files and Folders homepagestore BOOK: Professional ASP.NET 3.5 SP1 Edition: In C# and VB 2 December 13th, 2009 01:50 AM
compress a set of files and folders prathapkumar ASP.NET 3.5 Basics 1 September 11th, 2009 04:48 AM
connect to files from different folders lcyean ASP.NET 2.0 Basics 1 May 11th, 2007 07:23 AM
Including files across folders dsunmedia Beginning PHP 3 July 26th, 2004 04:17 PM





Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.