I would love to spend the time to figure this out on my own but I am in a bit
of a time crunch. Does anyone have some code for search a given directory and
all subdirectories for a specific file type (*.xls). Using file system object
is my preference but I am not too fussy. I would like to return the file name
and path.
--
HTH...
Jim Thomlinson
Hi Jim,
Why reinvent the wheel. This ought to work...
Regards,
Jim Cone
San Francisco, USA
Microsoft Windows Script 5.6 Documentation
http://msdn.microsoft.com/library/de...ist/webdev.asp
'----------------------------------
Option Explicit
Option Compare Text
Sub ListFoldersAndSubFolderAndFiles()
Jim Cone - San Francisco, USA - May 24, 2005/July,02, 2005
'Requires a project reference to "Microsoft Scripting Runtime" (scrrun.dll)
'List all files and folders in the specified folder.
Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objFile As Scripting.File
Dim strPath As String
Dim strName As String
Dim lngNum As Long
'Specify the folder...
strPath = "C:\Documents and Settings"
'Specify the file to look for...
strName = "*.xls"
Set objFSO = New Scripting.FileSystemObject
Set objFolder = objFSO.GetFolder(strPath)
lngNum = 2
For Each objFile In objFolder.Files
If objFile.Name Like strName Then
Cells(lngNum, 2) = objFile.Path
lngNum = lngNum + 1
End If
Next 'objFile
Set objFile = Nothing
'Call recursive function
DoTheSubFolders objFolder.SubFolders, lngNum, strName
Set objFSO = Nothing
Set objFolder = Nothing
End Sub
'------------------------
Function DoTheSubFolders(ByRef objFolders As Scripting.Folders, _
ByRef lngN As Long, ByRef strTitle As String)
Dim scrFolder As Scripting.Folder
Dim scrFile As Scripting.File
Dim lngCnt As Long
For Each scrFolder In objFolders
For Each scrFile In scrFolder.Files
If scrFile.Name Like strTitle Then
Cells(lngN, 2).Value = scrFile.Path
lngN = lngN + 1
End If
Next 'scrFile
'If there are more sub folders then go back and run function again.
If scrFolder.SubFolders.Count > 0 Then
DoTheSubFolders scrFolder.SubFolders, lngN, strTitle
End If
Next 'scrFolder
Set scrFile = Nothing
Set scrFolder = Nothing
End Function
'-------------------
"Jim Thomlinson" <[email protected]>
wrote in message
news:[email protected]...
I would love to spend the time to figure this out on my own but I am in a bit
of a time crunch. Does anyone have some code for search a given directory and
all subdirectories for a specific file type (*.xls). Using file system object
is my preference but I am not too fussy. I would like to return the file name
and path.--
HTH...
Jim Thomlinson
Thanks. I had the first sub but I did not have the recursive section... That
saves time...
--
HTH...
Jim Thomlinson
"Jim Cone" wrote:
> Hi Jim,
> Why reinvent the wheel. This ought to work...
> Regards,
> Jim Cone
> San Francisco, USA
>
> Microsoft Windows Script 5.6 Documentation
> http://msdn.microsoft.com/library/de...ist/webdev.asp
> '----------------------------------
> Option Explicit
> Option Compare Text
> Sub ListFoldersAndSubFolderAndFiles()
> Jim Cone - San Francisco, USA - May 24, 2005/July,02, 2005
> 'Requires a project reference to "Microsoft Scripting Runtime" (scrrun.dll)
> 'List all files and folders in the specified folder.
>
> Dim objFSO As Scripting.FileSystemObject
> Dim objFolder As Scripting.Folder
> Dim objFile As Scripting.File
> Dim strPath As String
> Dim strName As String
> Dim lngNum As Long
>
> 'Specify the folder...
> strPath = "C:\Documents and Settings"
> 'Specify the file to look for...
> strName = "*.xls"
> Set objFSO = New Scripting.FileSystemObject
> Set objFolder = objFSO.GetFolder(strPath)
> lngNum = 2
>
> For Each objFile In objFolder.Files
> If objFile.Name Like strName Then
> Cells(lngNum, 2) = objFile.Path
> lngNum = lngNum + 1
> End If
> Next 'objFile
> Set objFile = Nothing
>
> 'Call recursive function
> DoTheSubFolders objFolder.SubFolders, lngNum, strName
>
> Set objFSO = Nothing
> Set objFolder = Nothing
> End Sub
> '------------------------
>
> Function DoTheSubFolders(ByRef objFolders As Scripting.Folders, _
> ByRef lngN As Long, ByRef strTitle As String)
> Dim scrFolder As Scripting.Folder
> Dim scrFile As Scripting.File
> Dim lngCnt As Long
>
> For Each scrFolder In objFolders
> For Each scrFile In scrFolder.Files
> If scrFile.Name Like strTitle Then
> Cells(lngN, 2).Value = scrFile.Path
> lngN = lngN + 1
> End If
> Next 'scrFile
>
> 'If there are more sub folders then go back and run function again.
> If scrFolder.SubFolders.Count > 0 Then
> DoTheSubFolders scrFolder.SubFolders, lngN, strTitle
> End If
> Next 'scrFolder
>
> Set scrFile = Nothing
> Set scrFolder = Nothing
> End Function
> '-------------------
>
>
> "Jim Thomlinson" <[email protected]>
> wrote in message
> news:[email protected]...
> I would love to spend the time to figure this out on my own but I am in a bit
> of a time crunch. Does anyone have some code for search a given directory and
> all subdirectories for a specific file type (*.xls). Using file system object
> is my preference but I am not too fussy. I would like to return the file name
> and path.--
> HTH...
> Jim Thomlinson
>
FYI, I ran into one very small glitch. I do not have access to one of the
subdirectories. Added this little tidbit of code... Seems to be running
again...
Function DoTheSubFolders(ByRef objFolders As Scripting.Folders, _
ByRef lngN As Long, ByRef strTitle As String)
Dim scrFolder As Scripting.Folder
Dim scrFile As Scripting.File
Dim lngCnt As Long
On Error Goto ErrorHandler
For Each scrFolder In objFolders
For Each scrFile In scrFolder.Files
If scrFile.Name Like strTitle Then
Cells(lngN, 2).Value = scrFile.Path
lngN = lngN + 1
End If
Next 'scrFile
'If there are more sub folders then go back and run function again.
If scrFolder.SubFolders.Count > 0 Then
DoTheSubFolders scrFolder.SubFolders, lngN, strTitle
End If
Next 'scrFolder
ErrorHandler:
Set scrFile = Nothing
Set scrFolder = Nothing
End Function
--
HTH...
Jim Thomlinson
"Jim Cone" wrote:
> Hi Jim,
> Why reinvent the wheel. This ought to work...
> Regards,
> Jim Cone
> San Francisco, USA
>
> Microsoft Windows Script 5.6 Documentation
> http://msdn.microsoft.com/library/de...ist/webdev.asp
> '----------------------------------
> Option Explicit
> Option Compare Text
> Sub ListFoldersAndSubFolderAndFiles()
> Jim Cone - San Francisco, USA - May 24, 2005/July,02, 2005
> 'Requires a project reference to "Microsoft Scripting Runtime" (scrrun.dll)
> 'List all files and folders in the specified folder.
>
> Dim objFSO As Scripting.FileSystemObject
> Dim objFolder As Scripting.Folder
> Dim objFile As Scripting.File
> Dim strPath As String
> Dim strName As String
> Dim lngNum As Long
>
> 'Specify the folder...
> strPath = "C:\Documents and Settings"
> 'Specify the file to look for...
> strName = "*.xls"
> Set objFSO = New Scripting.FileSystemObject
> Set objFolder = objFSO.GetFolder(strPath)
> lngNum = 2
>
> For Each objFile In objFolder.Files
> If objFile.Name Like strName Then
> Cells(lngNum, 2) = objFile.Path
> lngNum = lngNum + 1
> End If
> Next 'objFile
> Set objFile = Nothing
>
> 'Call recursive function
> DoTheSubFolders objFolder.SubFolders, lngNum, strName
>
> Set objFSO = Nothing
> Set objFolder = Nothing
> End Sub
> '------------------------
>
> Function DoTheSubFolders(ByRef objFolders As Scripting.Folders, _
> ByRef lngN As Long, ByRef strTitle As String)
> Dim scrFolder As Scripting.Folder
> Dim scrFile As Scripting.File
> Dim lngCnt As Long
>
> For Each scrFolder In objFolders
> For Each scrFile In scrFolder.Files
> If scrFile.Name Like strTitle Then
> Cells(lngN, 2).Value = scrFile.Path
> lngN = lngN + 1
> End If
> Next 'scrFile
>
> 'If there are more sub folders then go back and run function again.
> If scrFolder.SubFolders.Count > 0 Then
> DoTheSubFolders scrFolder.SubFolders, lngN, strTitle
> End If
> Next 'scrFolder
>
> Set scrFile = Nothing
> Set scrFolder = Nothing
> End Function
> '-------------------
>
>
> "Jim Thomlinson" <[email protected]>
> wrote in message
> news:[email protected]...
> I would love to spend the time to figure this out on my own but I am in a bit
> of a time crunch. Does anyone have some code for search a given directory and
> all subdirectories for a specific file type (*.xls). Using file system object
> is my preference but I am not too fussy. I would like to return the file name
> and path.--
> HTH...
> Jim Thomlinson
>
Jim,
You can run into errors ...
1. with the system volume folder - you have to stay away from it
2. with the "If scrFolder.SubFolders.Count > 0", it errors if there are no subfolders.
You either have to trap errors at the appropriate point or put a blanket
on error resume next in the code.
Regards,
Jim Cone
"Jim Thomlinson"
<[email protected]>
wrote in message
news:[email protected]
FYI, I ran into one very small glitch. I do not have access to one of the
subdirectories. Added this little tidbit of code... Seems to be running
again...
Function DoTheSubFolders(ByRef objFolders As Scripting.Folders, _
ByRef lngN As Long, ByRef strTitle As String)
Dim scrFolder As Scripting.Folder
Dim scrFile As Scripting.File
Dim lngCnt As Long
On Error Goto ErrorHandler
For Each scrFolder In objFolders
For Each scrFile In scrFolder.Files
If scrFile.Name Like strTitle Then
Cells(lngN, 2).Value = scrFile.Path
lngN = lngN + 1
End If
Next 'scrFile
'If there are more sub folders then go back and run function again.
If scrFolder.SubFolders.Count > 0 Then
DoTheSubFolders scrFolder.SubFolders, lngN, strTitle
End If
Next 'scrFolder
ErrorHandler:
Set scrFile = Nothing
Set scrFolder = Nothing
End Function--
HTH...
Jim Thomlinson
Look at the thread DOS....there must be a better way, dated 8 Oct 2005.
RBS
"Jim Thomlinson" <[email protected]> wrote in message
news:[email protected]...
>I would love to spend the time to figure this out on my own but I am in a
>bit
> of a time crunch. Does anyone have some code for search a given directory
> and
> all subdirectories for a specific file type (*.xls). Using file system
> object
> is my preference but I am not too fussy. I would like to return the file
> name
> and path.
> --
> HTH...
>
> Jim Thomlinson
There are currently 1 users browsing this thread. (0 members and 1 guests)
Posting Permissions
LinkBack URL
About LinkBacks
Register To Reply
Bookmarks