I have a macro that steps through each folder and reports it's size. I need
to also have it Look for a project.inf file in each folder and if it exists
add the string to a cell on the current worksheet. This is the code that I
have so far. The code does not contain any attempt to open the project.inf
file yet.

Thanks

Steve

Sub FolderSizeToWorksheet(sfol As Variant)
Dim fso As New FileSystemObject
Dim fld As Folder
Dim tFld As Folder
'Dim sfol As String

Application.ScreenUpdating = False
'sfol = "N:\Database"
Set fld = fso.GetFolder(sfol)
i = 0
For Each tFld In fld.SubFolders
i = i + 1

Cells(i, 1).Value = tFld.Name
Cells(i, 2).Value = tFld.Size
Cells(i, 3).Value = Cells(i, 2) / 1024
Cells(i, 4).Value = tFld.DateCreated
Cells(i, 5).Value = tFld.DateLastModified
With Application.FileSearch
.NewSearch
.LookIn = tFld
.SearchSubFolders = False
.Filename = "Project.inf"

If .Execute() 0 Then
ReDim Preserve Myfiles(1 To .FoundFiles.Count)
Application.StatusBar = "Found Files: " & .FoundFiles.Count
For i = 1 To .FoundFiles.Count
Myfiles(i) = .FoundFiles(i)
Next i
Else
MsgBox "There were no files found"
Exit Sub
End If
End With

If tFld.Size < 200 Then
tFld.Delete True
Cells(i, 6).Value = "Deleted"
End If
Next

Application.ScreenUpdating = True
End Sub

Code seems to work. What are you asking?

why do you jump out of the sub the first time you hit a subdirectory where
no files are found?

--
Regards,
Tom Ogilvy

"Steve Roberts" wrote in message
...
I have a macro that steps through each folder and reports it's size. I
need
to also have it Look for a project.inf file in each folder and if it
exists
add the string to a cell on the current worksheet. This is the code that I
have so far. The code does not contain any attempt to open the project.inf
file yet.

Thanks

Steve

Sub FolderSizeToWorksheet(sfol As Variant)
Dim fso As New FileSystemObject
Dim fld As Folder
Dim tFld As Folder
'Dim sfol As String

Application.ScreenUpdating = False
'sfol = "N:\Database"
Set fld = fso.GetFolder(sfol)
i = 0
For Each tFld In fld.SubFolders
i = i + 1

Cells(i, 1).Value = tFld.Name
Cells(i, 2).Value = tFld.Size
Cells(i, 3).Value = Cells(i, 2) / 1024
Cells(i, 4).Value = tFld.DateCreated
Cells(i, 5).Value = tFld.DateLastModified
With Application.FileSearch
.NewSearch
.LookIn = tFld
.SearchSubFolders = False
.Filename = "Project.inf"

If .Execute() 0 Then
ReDim Preserve Myfiles(1 To .FoundFiles.Count)
Application.StatusBar = "Found Files: " & .FoundFiles.Count
For i = 1 To .FoundFiles.Count
Myfiles(i) = .FoundFiles(i)
Next i
Else
MsgBox "There were no files found"
Exit Sub
End If
End With

If tFld.Size < 200 Then
tFld.Delete True
Cells(i, 6).Value = "Deleted"
End If
Next

Application.ScreenUpdating = True
End Sub