S
Steve Roberts
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
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