Link to home
Start Free TrialLog in
Avatar of Angelmar
AngelmarFlag for United States of America

asked on

Folder and SubFolder Names to Excel

Hi,

I want to copy all the folder and sub folder names from a mapped drive to an excel file.  Is this possible?
Avatar of Angelmar
Angelmar
Flag of United States of America image

ASKER

oops! forgot to set the point.
Avatar of Ken Butters
Yes... found it already written to do exactly that here:

http://www.ozgrid.com/forum/showthread.php?t=69086

Sub Ck() 
     
    Dim strStartPath As String 
     
    strStartPath = "C:\" 'ENTER YOUR START FOLDER HERE
    ListFolder strStartPath 
     
End Sub 
Sub ListFolder(sFolderPath As String) 
     
    Dim FS As New FileSystemObject 
    Dim FSfolder As Folder 
    Dim subfolder As Folder 
    Dim i As Integer 
     
    Set FSfolder = FS.GetFolder(sFolderPath) 
     
    For Each subfolder In FSfolder.SubFolders 
        DoEvents 
        i = i + 1 
         'added this line
        Cells(i, 1) = subfolder 
         'commented out this one
         'Debug.Print subfolder
    Next subfolder 
     
    Set FSfolder = Nothing 
     
     'optional, I suppose
    MsgBox "Total sub folders in " & sFolderPath & " : " & i 
     
End Sub 

Open in new window

and if the drive is mapped?
Change the startPath variable

Instead of strStartPath = "C:\"

change to strStartPath = "M:\" or whatever folder you want to start in.
It doesn't recognize the file path when i use the mapped letter
Even tried using server name \\servername\folder
Hmm... worked for me when I tried a mapped drive...

Try opening windows explorer and verify that you can navigate to the mapped drive, and see folders/files there.
I have a windows 7 64 bit machine... and have noticed that sometimes I have to navigate to mapped folders ... especially after initial logon to the domain, before the mapped drive/folders/files actually become available to my applications.

so after you are able to navigate there in explorer... then try running the vba code again.
In the link you sent over it states that i should go to Tools/References and clicked "Microsoft Scripting Runtime". I have Scripting Runtime grayed out. Do i have to download it first? Im running W7 32bit.
This could indicate a larger problem with your machine.

First step... go to your windows system32 folder and see if you can find the following file "C:\Windows\system32\scrrun.dll"

if it exists then it could be a problem with your registry...

you could try to re-register it with your system:

Open DOS window and type :
regsvr32 c:\windows\system32\scrrun.dll
it worked but didn't print out to excel worksheet
so, copied
ption Explicit
 
Sub TestListFolders()
     
    Application.ScreenUpdating = False
     
     'create a new workbook for the folder list
     
     'commented out by dr
     'Workbooks.Add
     
     'line added by dr to clear old data
    Cells.Delete
     
     ' add headers
    With Range("A1")
        .Formula = "Folder contents:"
        .Font.Bold = True
        .Font.Size = 12
    End With
     
    Range("A3").Formula = "Folder Path:"
    Range("B3").Formula = "Folder Name:"
    Range("C3").Formula = "Size:"
    Range("D3").Formula = "Subfolders:"
    Range("E3").Formula = "Files:"
    Range("F3").Formula = "Short Name:"
    Range("G3").Formula = "Short Path:"
    Range("A3:G3").Font.Bold = True
     
     'ENTER START FOLDER HERE
     ' and include subfolders (true/false)
    ListFolders "C:\", True
     
    Application.ScreenUpdating = True
     
End Sub
 
Sub ListFolders(SourceFolderName As String, IncludeSubfolders As Boolean)
     ' lists information about the folders in SourceFolder
     ' example: ListFolders "C:\", True
    Dim FSO As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
    Dim r As Long
     
    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)
     
     'line added by dr for repeated "Permission Denied" errors
     
    On Error Resume Next
     
     ' display folder properties
    r = Range("A65536").End(xlUp).Row + 1
    Cells(r, 1).Formula = SourceFolder.Path
    Cells(r, 2).Formula = SourceFolder.Name
    Cells(r, 3).Formula = SourceFolder.Size
    Cells(r, 4).Formula = SourceFolder.SubFolders.Count
    Cells(r, 5).Formula = SourceFolder.Files.Count
    Cells(r, 6).Formula = SourceFolder.ShortName
    Cells(r, 7).Formula = SourceFolder.ShortPath
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFolders SubFolder.Path, True
        Next SubFolder
        Set SubFolder = Nothing
    End If
     
    Columns("A:G").AutoFit
     
    Set SourceFolder = Nothing
    Set FSO = Nothing
     
     'commented out by dr
     'ActiveWorkbook.Saved = True
     
End Sub  

And still no luck
ASKER CERTIFIED SOLUTION
Avatar of Ken Butters
Ken Butters
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Success! Thanks for sticking with me through it!