Pages

Saturday, May 19, 2012

Get Names of all the folders stored in a folder/directory Including Sub folder

If you want to get the names of all the folders in a directory/folder (Including Sub folders name).

Sub folder_names_including_subfolder()
Application.ScreenUpdating = False
Dim fldpath
Dim fso As Object, j As Long, folder1 As Object
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
Workbooks.Add
Cells(1, 1).Value = fldpath
Cells(2, 1).Value = "Path"
Cells(2, 2).Value = "Dir"
Cells(2, 3).Value = "Name"
Cells(2, 4).Value = "Date Created"
Cells(2, 5).Value = "Date Last Modified"
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder1 = fso.getfolder(fldpath)
get_sub_folder folder1
Set fso = Nothing
Range("a1").Font.Size = 9
ActiveWindow.DisplayGridlines = False
Range("a3:e" & Range("a2").End(xlDown).Row).Font.Size = 9
Range("a2:e2").Interior.Color = vbCyan
Columns("c:h").AutoFit
Application.ScreenUpdating = True
End Sub

Sub get_sub_folder(ByRef prntfld As Object)
Dim SubFolder As Object, subfld As Object, j As Long
For Each SubFolder In prntfld.SubFolders
j = Range("A1").End(xlDown).Row + 1
Cells(j, 1).Value = SubFolder.Path
Cells(j, 2).Value = Left(SubFolder.Path, InStrRev(SubFolder.Path, "\"))
Cells(j, 3).Value = SubFolder.Name
Cells(j, 4).Value = SubFolder.DateCreated
Cells(j, 5).Value = SubFolder.DateLastModified
Next SubFolder
For Each subfld In prntfld.SubFolders
get_sub_folder subfld
Next subfld
End Sub

1 comment:

  1. Hi Team,

    Please explain to me, Iam beginner for Excel VBA macros.

    I want check image details from a folder, like image name, format, size, horizontal resolution, vertical resolution, height, width, overall dimensions, modified date, bit depth, color mode (RGB/CMYK) and compression (LZW/none for TIFF format).

    I have searched in many forum, but didn't get proper info. And someone helped me to get image name, format, size, horizontal resolution, vertical resolution, height, width, modified date, bit depth and overall dimensions, except color mode (RGB/CMYK) and compression (LZW/none for TIFF format). Below mentioned code for this.

    Sub GetImageInfo()
    Dim i As Integer, SourceFldr
    Dim c As Range, rng As Range
    Dim sFile As Variant
    Dim oWSHShell As Object

    Dim fldr As FileDialog
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    Set oWSHShell = CreateObject("WScript.Shell")

    With fldr
    .Title = "Select a Source Folder"
    .AllowMultiSelect = False
    .InitialFileName = oWSHShell.SpecialFolders("Desktop")
    If .Show <> -1 Then GoTo NextCode
    SourceFldr = .SelectedItems(1)
    NextCode:
    End With

    Dim oShell: Set oShell = CreateObject("Shell.Application")
    Dim oDir: Set oDir = oShell.Namespace(SourceFldr)

    i = 3
    Range("A3:K5000").ClearContents

    For Each sFile In oDir.Items
    Cells(i, 1).Value = oDir.GetDetailsOf(sFile, 0)
    Cells(i, 2).Value = oDir.GetDetailsOf(sFile, 1)
    Cells(i, 3).Value = oDir.GetDetailsOf(sFile, 2)
    Cells(i, 4).Value = oDir.GetDetailsOf(sFile, 5)
    Cells(i, 5).Value = oDir.GetDetailsOf(sFile, 12)
    Cells(i, 6).Value = oDir.GetDetailsOf(sFile, 31)
    Cells(i, 7).Value = oDir.GetDetailsOf(sFile, 160)
    Cells(i, 8).Value = oDir.GetDetailsOf(sFile, 164)
    Cells(i, 9).Value = oDir.GetDetailsOf(sFile, 162)
    Cells(i, 10).Value = oDir.GetDetailsOf(sFile, 161)
    Cells(i, 11).Value = oDir.GetDetailsOf(sFile, 163)
    i = i + 1
    Next
    Set oDir = Nothing
    Set oShell = Nothing
    Cells.Columns.AutoFit
    MsgBox "Done"
    End Sub

    Someone suggested me to use third party DLLs (imagemagick, and so on) u will definitely get all image details, but i dont know how to use, bcoz m beginner for VBA.

    Pls help me

    ReplyDelete