Sensing files in a directory

leydorfs

Board Regular
Joined
Feb 12, 2005
Messages
83
1. I have a group of excel files in a directory. They all contain a workbook named "projects". I don't know how many files will be in the directory.
I'd like to write a VBA script to detect each file, then reference a specific cell from the workbook "projects" in each file. How can this be done.

2. If so, I'd like to recurse subdirectories of the file, and reference the same cell.

Thanks.
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Well, first you start out with the recursive routine to generate your filelist.

Here's one take on what this might look like:

Code:
Sub foobar()
Dim fso As Object
Dim strName As String
Dim strArr(1 To 65536, 1 To 1) As String, i As Long

Const strDir As String = "C:\temp"
Const searchTerm As String = "projects"

Let strName = Dir$(strDir & "\*" & searchTerm & "*.xls")
Do While strName <> vbNullString
    Let i = i + 1
    Let strArr(i, 1) = strDir & "\" & strName
    Let strName = Dir$()
Loop
Set fso = CreateObject("Scripting.FileSystemObject")
Call recurseSubFolders(fso.GetFolder(strDir), strArr(), i, searchTerm)
Set fso = Nothing
If i > 0 Then
    Range("A1").Resize(i).Value = strArr
End If
End Sub

Private Sub recurseSubFolders(ByRef Folder As Object, _
    ByRef strArr() As String, _
    ByRef i As Long, _
    ByRef searchTerm As String)
Dim SubFolder As Object
Dim strName As String
For Each SubFolder In Folder.SubFolders
    Let strName = Dir$(SubFolder.Path & "\*" & searchTerm & "*.xls")
    Do While strName <> vbNullString
        Let i = i + 1
        Let strArr(i, 1) = SubFolder.Path & "\" & strName
        Let strName = Dir$()
    Loop
    Call recurseSubFolders(SubFolder, strArr(), i, searchTerm)
Next
End Sub
Note though, Indirect() does not work on closed files. ;)
 
Upvote 0
Can you show me how to modify this code set for 2003/2007?

I have a directory on my hard drive full of mp3 files. I would like to rename each file to a new name that I specify on an Excel worksheet. Previously, my code was working fine as follows:

Sub RenameFiles()
'Used to quickly rename mp3 files in a folder to a list of song names on an Excel sheet

Dim myCell As Range
Set myCell = Sheets("MySongs").Range("B1") 'specify starting location of cells containing correct song names

Set fs = Application.FileSearch 'use search function to find files
With fs
.NewSearch
.LookIn = "C:\Music\Album1" 'path where mp3 files you want to rename reside
.FileName = "*.mp3" 'look only for mp3 files

If .Execute > 0 Then
'If .Execute > 0 Then
For i = 1 To .FoundFiles.Count 'operate only on the number of mp3 files found
Dim gs, gsFile
Set gs = CreateObject("Scripting.FileSystemObject") 'provides access to computer's file system
Set gsFile = gs.GetFile(.FoundFiles(i))
gsFile.Name = myCell.Value & ".mp3"
Set myCell = myCell.Offset(1, 0)
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub

For some reason, this code does not work on Excel 2003 SP2, nor Excel 2007. Any ideas?
 
Upvote 0
Well, first you start out with the recursive routine to generate your filelist.

Here's one take on what this might look like:

Code:
Sub foobar()
Dim fso As Object
Dim strName As String
Dim strArr(1 To 65536, 1 To 1) As String, i As Long
 
Const strDir As String = "C:\temp"
Const searchTerm As String = "projects"
 
Let strName = Dir$(strDir & "\*" & searchTerm & "*.xls")
Do While strName <> vbNullString
    Let i = i + 1
    Let strArr(i, 1) = strDir & "\" & strName
    Let strName = Dir$()
Loop
Set fso = CreateObject("Scripting.FileSystemObject")
Call recurseSubFolders(fso.GetFolder(strDir), strArr(), i, searchTerm)
Set fso = Nothing
If i > 0 Then
    Range("A1").Resize(i).Value = strArr
End If
End Sub
 
Private Sub recurseSubFolders(ByRef Folder As Object, _
    ByRef strArr() As String, _
    ByRef i As Long, _
    ByRef searchTerm As String)
Dim SubFolder As Object
Dim strName As String
For Each SubFolder In Folder.SubFolders
    Let strName = Dir$(SubFolder.Path & "\*" & searchTerm & "*.xls")
    Do While strName <> vbNullString
        Let i = i + 1
        Let strArr(i, 1) = SubFolder.Path & "\" & strName
        Let strName = Dir$()
    Loop
    Call recurseSubFolders(SubFolder, strArr(), i, searchTerm)
Next
End Sub
Note though, Indirect() does not work on closed files. ;)

Hi Nate, I know it is an older question, but I have a question about this.
Is it possible to save your file automatically with next following numer?
propose, I have 3 file called "BE080001", "BE080002", "BE080003". When I click the macro button in Excel 2007, the file must be saved in a folder like C:\Test with he filename "BE080003". So he have to count + 1 and save.
I hope you can help.

Kind Regards
 
Upvote 0
Hello,

I'm not following what you're saving, the returned files? Haven't you already saved them? :confused:
 
Upvote 0
Hey Nate,

Here is what I need to do... I have a path that contains 3 folders, but within each folder there are multiple subfolders. I want to go through each .xls file in the folders and get a value from a specific cell on the same worksheet in each file and then save the value from that cell in a new workbook. I want to save the value from all of the .xls files to the same new workbook, so that at the end I will have a workbook that will show me the value for this cell in one spot. I used to be able to do this using the aforementioned Application.FileSearch, but I cannot figure it out using the fso.

Here is a basic idea of what I need:

1) open every excel file in the path, including subfolders
2) get the value from cell a1 on sheet named "data"
3) save the value from step 2 to a new workbook and add a new row for each entry from every excel file
4) close the opened excel file, do not save
5) save the new workbook
6) go back to step 1 and open the next excel file
7) continue until all excel files have been opened and data saved in the new workbook
 
Upvote 0
Very Urgent : Reading data in excel in multiple sub-folders

Am trying to find a solution to loop through sub-folders and read into several excel file having the sheet name "OIM Report" and then consolidate them into a file in the parent folder under the sheet "Consolidated". Can you please help ??
 
Upvote 0
Hi Nate,
I tried the code used here but got stock on the
Const searchTerm As String = "projects"
because is a set term. I am trying to use a "number" from a UserForm Text box.

It works on the excel 2003 but not on the 2007

Please! I need your help.

Here is my code:

========
Sub FindThatFile()

Dim strMyString As String

strMyString = UserForm30.TextBox1.Value


With Application.FileSearch
.Filename = strMyString
.LookIn = "\\Ddnydc3\drafting"
.FileType = msoFileTypeAllFiles

.SearchSubFolders = True
.MatchTextExactly = True

.Execute


If .Execute() > 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
For i = 1 To .FoundFiles.Count

UserForm31.TextBox1.Text = .FoundFiles(i)
UserForm31.Show


Next i
UserForm30.TextBox1.AutoTab = True
UserForm30.TextBox1.SetFocus
UserForm30.TextBox1.Value = "00"

Else

MsgBox "That Part Number has NOT been scanned or it Does NOT Exist", _
vbExclamation + vbOKOnly, _
"Sorry!"
UserForm30.TextBox1.AutoTab = True
UserForm30.TextBox1.SetFocus

End If
End With
End Sub
=============



Well, first you start out with the recursive routine to generate your filelist.

Here's one take on what this might look like:

Code:
Sub foobar()
Dim fso As Object
Dim strName As String
Dim strArr(1 To 65536, 1 To 1) As String, i As Long
 
Const strDir As String = "C:\temp"
Const searchTerm As String = "projects"
 
Let strName = Dir$(strDir & "\*" & searchTerm & "*.xls")
Do While strName <> vbNullString
    Let i = i + 1
    Let strArr(i, 1) = strDir & "\" & strName
    Let strName = Dir$()
Loop
Set fso = CreateObject("Scripting.FileSystemObject")
Call recurseSubFolders(fso.GetFolder(strDir), strArr(), i, searchTerm)
Set fso = Nothing
If i > 0 Then
    Range("A1").Resize(i).Value = strArr
End If
End Sub
 
Private Sub recurseSubFolders(ByRef Folder As Object, _
    ByRef strArr() As String, _
    ByRef i As Long, _
    ByRef searchTerm As String)
Dim SubFolder As Object
Dim strName As String
For Each SubFolder In Folder.SubFolders
    Let strName = Dir$(SubFolder.Path & "\*" & searchTerm & "*.xls")
    Do While strName <> vbNullString
        Let i = i + 1
        Let strArr(i, 1) = SubFolder.Path & "\" & strName
        Let strName = Dir$()
    Loop
    Call recurseSubFolders(SubFolder, strArr(), i, searchTerm)
Next
End Sub
Note though, Indirect() does not work on closed files. ;)
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top