How to display the output in a same worksheet?

[dm28949]

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

[JKwan]

is this what you wanted?


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
Dim LastRow As Long

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 = ActiveSheet
LastRow = FindLastRow(newSheet, "A")

If LastRow = 1 Then
newSheet.Cells(1, 1).Value = fldpath
newSheet.Cells(2, 1).Value = "Path"
newSheet.Cells(2, 2).Value = "Date Created"
newSheet.Cells(2, 3).Value = "Date Last Modified"
newSheet.Cells(2, 4).Value = "Size"
Else
newSheet.Cells(LastRow + 2, 1).Value = fldpath
newSheet.Cells(LastRow + 3, 1).Value = "Path"
newSheet.Cells(LastRow + 3, 2).Value = "Date Created"
newSheet.Cells(LastRow + 3, 3).Value = "Date Last Modified"
newSheet.Cells(LastRow + 3, 4).Value = "Size"
End If


LastRow = FindLastRow(newSheet, "A")
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(fldpath)
Set SubFolders = folder.SubFolders
j = LastRow + 1
For Each SubFolder In SubFolders
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")
j = j + 1
Next SubFolder
Set fso = Nothing
Range("a" & LastRow - 1).Font.Size = 11
ActiveWindow.DisplayGridlines = True
Range("a3:e" & Range("a2").End(xlDown).Row).Font.Size = 11
Range("a" & LastRow & ":e" & LastRow).Interior.Color = vbCyan
Columns("A:H").AutoFit
Application.ScreenUpdating = True
End Sub
Function FindLastRow(ByVal WS As Worksheet, ColumnLetter As String) As Long
FindLastRow = WS.Range(ColumnLetter & Rows.Count).End(xlUp).Row
End Function

[dm28949]

Yes!! Thanks a lot!

[dm28949]

How make this code to work for Zipped folders?