Angelmar
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?
I want to copy all the folder and sub folder names from a mapped drive to an excel file. Is this possible?
Yes... found it already written to do exactly that here:
http://www.ozgrid.com/foru m/showthre ad.php?t=6 9086
http://www.ozgrid.com/foru
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
ASKER
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.
Instead of strStartPath = "C:\"
change to strStartPath = "M:\" or whatever folder you want to start in.
ASKER
It doesn't recognize the file path when i use the mapped letter
ASKER
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.
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.
so after you are able to navigate there in explorer... then try running the vba code again.
ASKER
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\scrru n.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
First step... go to your windows system32 folder and see if you can find the following file "C:\Windows\system32\scrru
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
ASKER
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(SourceFolderNa me 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(SourceFolder Name)
'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.Co unt
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
so, copied
ption Explicit
Sub TestListFolders()
Application.ScreenUpdating
'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
End Sub
Sub ListFolders(SourceFolderNa
' 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(SourceFolder
'line added by dr for repeated "Permission Denied" errors
On Error Resume Next
' display folder properties
r = Range("A65536").End(xlUp).
Cells(r, 1).Formula = SourceFolder.Path
Cells(r, 2).Formula = SourceFolder.Name
Cells(r, 3).Formula = SourceFolder.Size
Cells(r, 4).Formula = SourceFolder.SubFolders.Co
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Success! Thanks for sticking with me through it!
ASKER