dm28949
02-05-2015, 02:05 PM
I found this macro which perfectly does the job that I am supposed to do but just to make it look nicer I am wondering if it is possible to modify the code so that it lists the output in a same worksheet instead of creating a new one each time.
This macro lists the properties of subfolders. What do I need to do to make it display the properties of diferent folders in a same sheet? Currently, I am going through folders one at a time and each time I open the next folder, output is listed in a new sheet.
I apologize if my question doesn't make sense.
Option Explicit
Public X()
Public i As Long
Public objShell, objFolder, objFolderItem
Public fso, oFolder, Fil
Sub RecordRetention()
Application.ScreenUpdating = False
Dim newSheet As Worksheet
Dim fldpath
Dim fso As Object, j As Long, folder, SubFolders, SubFolder
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choose the folder"
.Show
End With
On Error Resume Next
fldpath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
If fldpath = False Then
MsgBox "Folder Not Selected"
Exit Sub
End If
Set newSheet = ThisWorkbook.Sheets.Add
Cells(1, 1).Value = fldpath
Cells(2, 1).Value = "Path"
Cells(2, 2).Value = "Date Created"
Cells(2, 3).Value = "Date Last Modified"
Cells(2, 4).Value = "Size"
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(fldpath)
Set SubFolders = folder.SubFolders
For Each SubFolder In SubFolders
j = Range("A1").End(xlDown).Row + 1
Cells(j, 1).Value = SubFolder.Path
Cells(j, 2).Value = Format(SubFolder.DateCreated, "MM/DD/YYYY")
Cells(j, 3).Value = Format(SubFolder.DateLastModified, "MM/DD/YYYY")
Cells(j, 4).Value = Format(SubFolder.Size / 1024 / 1024, "0.0 \MB")
Next SubFolder
Set fso = Nothing
Range("a1").Font.Size = 11
ActiveWindow.DisplayGridlines = True
Range("a3:e" & Range("a2").End(xlDown).Row).Font.Size = 11
Range("a2:e2").Interior.Color = vbCyan
Columns("A:H").AutoFit
Application.ScreenUpdating = True
End Sub
This macro lists the properties of subfolders. What do I need to do to make it display the properties of diferent folders in a same sheet? Currently, I am going through folders one at a time and each time I open the next folder, output is listed in a new sheet.
I apologize if my question doesn't make sense.
Option Explicit
Public X()
Public i As Long
Public objShell, objFolder, objFolderItem
Public fso, oFolder, Fil
Sub RecordRetention()
Application.ScreenUpdating = False
Dim newSheet As Worksheet
Dim fldpath
Dim fso As Object, j As Long, folder, SubFolders, SubFolder
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choose the folder"
.Show
End With
On Error Resume Next
fldpath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
If fldpath = False Then
MsgBox "Folder Not Selected"
Exit Sub
End If
Set newSheet = ThisWorkbook.Sheets.Add
Cells(1, 1).Value = fldpath
Cells(2, 1).Value = "Path"
Cells(2, 2).Value = "Date Created"
Cells(2, 3).Value = "Date Last Modified"
Cells(2, 4).Value = "Size"
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(fldpath)
Set SubFolders = folder.SubFolders
For Each SubFolder In SubFolders
j = Range("A1").End(xlDown).Row + 1
Cells(j, 1).Value = SubFolder.Path
Cells(j, 2).Value = Format(SubFolder.DateCreated, "MM/DD/YYYY")
Cells(j, 3).Value = Format(SubFolder.DateLastModified, "MM/DD/YYYY")
Cells(j, 4).Value = Format(SubFolder.Size / 1024 / 1024, "0.0 \MB")
Next SubFolder
Set fso = Nothing
Range("a1").Font.Size = 11
ActiveWindow.DisplayGridlines = True
Range("a3:e" & Range("a2").End(xlDown).Row).Font.Size = 11
Range("a2:e2").Interior.Color = vbCyan
Columns("A:H").AutoFit
Application.ScreenUpdating = True
End Sub