HELP PLEASE: VBA List Folder size and File size, but not include subfolder

[ChristPotter]

example: i've "A" folder at "D:".. Floder "A" have folder "B", "C", "D", file a-z.. And folder "B", "C", and "D" have a lot of files at each folder.. Can i list just folder "B", "C", "D", and file a-z; without file in folder "B", "C" and "D"? I want name folder/file and the size.. THANKS>>>

 

[patel45]

Sub ListFoldersAndInfo()
  Dim FSO As Object
  Dim Folder As Object
  Dim FolderName As String
  Dim R As Long
  Dim Rng As Range
  Dim SubFolder As Object
  Dim Wks As Worksheet
  Dim RootFolder
  Dim filePath As String
  Dim fd As Object

    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    With fd
        .Title = "Select Folder"
        If .Show = -1 Then       'User pressed action button
            DoEvents
            FolderName = .SelectedItems(1)
        Else
            Set fd = Nothing
            Exit Sub
        End If
    End With
    Set fd = Nothing


    If Right(FolderName, 1) <> "\" Then FolderName = FolderName & "\"
    Set Wks = Worksheets(1)
    Set Rng = Wks.Range("B2")
    Wks.UsedRange.Offset(1, 0).ClearContents
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
      Set Folder = FSO.GetFolder(FolderName)
      R = 1
      Rng.Cells(R, 1) = Folder.Name
      Rng.Cells(R, 2) = Folder.Path
      Rng.Cells(R, 3) = Round(Folder.Size / 1024, 1) & " KB"
      
        For Each Folder In Folder.SubFolders
          R = R + 1
          Rng.Cells(R, 1) = Folder.Name
          Rng.Cells(R, 2) = Folder.Path
          Rng.Cells(R, 3) = Round(Folder.Size / 1024, 1) & " KB"

        Next Folder
        
    Set FSO = Nothing
End sub

Sub Filedir()
        Range("A7:A100").ClearContents
        Cells(7, 1).Value = "File Name"
        Cells(7, 2).Value = "DateCreated"
        Cells(7, 3).Value = "DateLastModified"
        Cells(7, 4).Value = "DateLastAccessed"
        Cells(7, 5).Value = "File size"
        fpath = "D:\test\"   '<<<<<<<<<< to be changed
        Call ShowFolderList(fpath, 8, 1)
End Sub
Sub ShowFolderList(fpath, arow, col)

        Dim fs, f, f1, s, sf
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set f = fs.GetFolder(fpath)
        Set sf = f.SubFolders
        Set NFile = f.Files

        For Each pf1 In NFile
            If pf1.Name = "" Then Exit Sub
'            attr = pf1.Attributes
            Cells(arow, col) = pf1.Name
            Cells(arow, col + 1) = pf1.DateCreated
            Cells(arow, col + 2) = pf1.DateLastModified
            Cells(arow, col + 3) = pf1.DateLastAccessed
            Cells(arow, col + 4) = pf1.Size
            
            arow = arow + 1
        Next
    End Sub

 

[ChristPotter]

Sub ListFoldersAndInfo()   Dim FSO As Object   Dim Folder As Object   Dim FolderName As String   Dim R As Long   Dim Rng As Range   Dim SubFolder As Object   Dim Wks As Worksheet   Dim RootFolder   Dim filePath As String   Dim fd As Object      Set fd = Application.FileDialog(msoFileDialogFolderPicker)     With fd         .Title = "Select Folder"         If .Show = -1 Then       'User pressed action button             DoEvents             FolderName = .SelectedItems(1)         Else             Set fd = Nothing             Exit Sub         End If     End With     Set fd = Nothing       If Right(FolderName, 1) <> "\" Then FolderName = FolderName & "\"     Set Wks = Worksheets(1)     Set Rng = Wks.Range("B2")     Wks.UsedRange.Offset(1, 0).ClearContents          Set FSO = CreateObject("Scripting.FileSystemObject")            Set Folder = FSO.GetFolder(FolderName)       R = 1       Rng.Cells(R, 1) = Folder.Name       Rng.Cells(R, 2) = Folder.Path       Rng.Cells(R, 3) = Round(Folder.Size / 1024, 1) & " KB"                For Each Folder In Folder.SubFolders           R = R + 1           Rng.Cells(R, 1) = Folder.Name           Rng.Cells(R, 2) = Folder.Path           Rng.Cells(R, 3) = Round(Folder.Size / 1024, 1) & " KB"          Next Folder              Set FSO = Nothing End sub  Sub Filedir()         Range("A7:A100").ClearContents         Cells(7, 1).Value = "File Name"         Cells(7, 2).Value = "DateCreated"         Cells(7, 3).Value = "DateLastModified"         Cells(7, 4).Value = "DateLastAccessed"         Cells(7, 5).Value = "File size"         fpath = "D:\test\"   '<<<<<<<<<< to be changed         Call ShowFolderList(fpath, 8, 1) End Sub Sub ShowFolderList(fpath, arow, col)          Dim fs, f, f1, s, sf         Set fs = CreateObject("Scripting.FileSystemObject")         Set f = fs.GetFolder(fpath)         Set sf = f.SubFolders         Set NFile = f.Files          For Each pf1 In NFile             If pf1.Name = "" Then Exit Sub '            attr = pf1.Attributes             Cells(arow, col) = pf1.Name             Cells(arow, col + 1) = pf1.DateCreated             Cells(arow, col + 2) = pf1.DateLastModified             Cells(arow, col + 3) = pf1.DateLastAccessed             Cells(arow, col + 4) = pf1.Size                          arow = arow + 1         Next     End Sub

can't read folder.. only read file... but thanks..

 

[patel45]

Sub ListFoldersAndInfo() - shows folders
Sub Filedir() - shows file in folder fpath
Sub ShowFolderList(fpath, arow, col) - is sub called from Filedir

 

[ChristPotter]

Sub ListFoldersAndInfo() - shows folders
Sub Filedir() - shows file in folder fpath
Sub ShowFolderList(fpath, arow, col) - is sub called from Filedir

It's work... Thanks.... :D
Can i change KB to MB and GB?

Cooolll....

 

[patel45]

Rng.Cells(R, 3) = Round(Folder.Size / 1024/ 1024, 1) & " MB"</pre>