• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1192
  • Last Modified:

File Structure in Excel VBA

I've seen alot of macros that output the Folder structure of a specified Folder path,
however i cant find anything that includes files.

Attached is pretty much the standard Macro.

The end result i'm hoping for is a way to Bulk Re-Name files and/or folders.

Can anyone help?
Sub BulkRenameDeleteFiles()
Dim FSO As Scripting.FileSystemObject
Dim FolderName As Folder
Dim objFolder As Folder
Dim objSubFolder As Folder
Dim objFileItem As File
Dim strTemp As String

Dim WB As Workbook
Dim WS As Worksheet
Dim Sheet As Worksheet

'Structure Addresses
Dim StartAdd As Range
Dim StartFullAdd As Range
Dim StartConcAdd As Range

'File System Object
Set FSO = CreateObject("Scripting.FileSystemObject")
'Select Folder
With Application.FileDialog(msoFileDialogFolderPicker)
  .AllowMultiSelect = False
  .InitialView = msoFileDialogViewDetails
  .ButtonName = "Select"
  .Title = "Folder to Rename/Delete"
  If .Show = -1 Then
    Set FolderName = FSO.GetFolder(.SelectedItems(1))
    Else
    GoTo Finish
  End If
End With

Set WB = Workbooks.Add
Set WS = WB.Sheets.Add

'Full String Start Point
Set StartAdd = WS.Cells(2, 3)
Set StartFullAdd = WS.Cells(2, 1)
Set StartConcAdd = WS.Cells(2, 2)


With WS
  .Name = "File Structure"
  'Delete Other Sheets
  Application.DisplayAlerts = False
  For Each Sheet In WB.Sheets
    If Sheet.Name <> "File Structure" Then Sheet.Delete
  Next Sheet
  Application.DisplayAlerts = True
End With

'Headings
StartFullAdd.Offset(-1) = "Full Path"
StartAdd.Offset(-1) = "Structured Path"
StartConcAdd.Offset(-1) = "Concatenated Path"

FolderStructure FolderName, StartAdd, StartFullAdd

'Clean up
Finish:
Set WS = Nothing
Set WB = Nothing
Set FSO = Nothing
Set FolderName = Nothing
End Sub

Sub FolderStructure(Fld As Scripting.Folder, FileOutput As Range, PathOutput As Range)
  Dim objFolder As Scripting.Folder
  Dim objFile As Scripting.File
  For Each objFolder In Fld.SubFolders
    FileOutput = objFolder.Name
    PathOutput = objFolder.Path

    'Set New Rows
    Set PathOutput = PathOutput.Offset(1, 0)
    'Stagger Columns for "Tree" effect
    Set FileOutput = FileOutput.Offset(1, 1)
    
    FolderStructure objFolder, FileOutput, PathOutput
    'Go back a Column
    Set FileOutput = FileOutput.Offset(0, -1)
  Next
End Sub

Open in new window

0
bromy2004
Asked:
bromy2004
1 Solution
 
peakpeakCommented:
In a command prompt, type:
Dir /s /b
It'll output all file names complete with path. You then pipe that into your bulk renaming command.
0
 
bromy2004Author Commented:
Is there code samples for excel VBA?
I know I could mix CMD and VBA but I am much more confident in VBA than CMD and can edit it easier to suit my requirements

0
 
Joanne M. OrzechManager, Document Services CenterCommented:
0
Free learning courses: Active Directory Deep Dive

Get a firm grasp on your IT environment when you learn Active Directory best practices with Veeam! Watch all, or choose any amount, of this three-part webinar series to improve your skills. From the basics to virtualization and backup, we got you covered.

 
Dave BrettCommented:
bromy2004,

The File Scripting Object gives you a Files collection that you can work with under the Folders collection, so you could modify the code like below

The FileSearch code that Jo provided used to be the best way to go as it gave recursive searching, unfortunately MSFT took FileSearch out of Xl2007.

The other way to works with Folders and Files is by using Dir, its the way I normally go

Cheers

Dave

Sub FolderStructure(Fld As Scripting.Folder, FileOutput As Range, PathOutput As Range)
  Dim objFolder As Scripting.Folder
  Dim objFile As Scripting.File
  For Each objFolder In Fld.SubFolders
    FileOutput = objFolder.Name
    PathOutput = objFolder.Path
    

    'Set New Rows
    Set PathOutput = PathOutput.Offset(1, 0)
    'Stagger Columns for "Tree" effect
    Set FileOutput = FileOutput.Offset(1, 1)
    For Each objFile In objFolder.Files
      FileOutput = objFile.Name
    Next
    FolderStructure objFolder, FileOutput, PathOutput
    'Go back a Column
    Set FileOutput = FileOutput.Offset(0, -1)
  Next
End Sub

Open in new window

0
 
Dave BrettCommented:
An example of using File Scripting to get Folders with a Dir to pick out all txt files in http://www.experts-exchange.com/Excel/Q_24901177.html

I borrowed from Patrick Matthews on the recursive Folder path walking

Dave
0
 
Dave BrettCommented:
<pinging bromy2004 :)>
0
 
bromy2004Author Commented:
:) sorry for the delay is response Dave.
I've put together a macro that lists the files and splits by / in the cells.
How would I go about re-naming the folders and/or files.
0
 
Dave BrettCommented:
No Probs :)

I would use VBA's Name Object, it's quite versatile

Name Statement
This example uses the Name statement to rename a file. For  purposes of this example, assume that the directories or folders that are  specified already exist. On the Macintosh, “HD:” is the default drive name and  portions of the pathname are separated by colons instead of backslashes. Dim OldName, NewName OldName = "OLDFILE": NewName = "NEWFILE"    ' Define file names. Name OldName As NewName    ' Rename file.   OldName = "C:\MYDIR\OLDFILE": NewName = "C:\YOURDIR\NEWFILE" Name OldName As NewName    ' Move and rename file. Name Statement Example

Name Statement Example

This example uses the Name statement to rename a file. For purposes of this example, assume that the directories or folders that are specified already exist. On the Macintosh, “HD:” is the default drive name and portions of the pathname are separated by colons instead of backslashes.
Dim OldName, NewNameOldName = "OLDFILE": NewName = "NEWFILE"    ' Define file names.Name OldName As NewName    ' Rename file. OldName = "C:\MYDIR\OLDFILE": NewName = "C:\YOURDIR\NEWFILE"Name OldName As NewName    ' Move and rename file.
Cheers

Dave

Open in new window

0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now