A-Z processing of folders

[Indigenous]

This code lists the filename and path for each document in a folder tree.
Filenames are listed in ascending order within each folder, but folders are processed in reverse alphabetical order. Take the example:

Main Folder (file_1, file_2)
Sub Folder A (file_11, file_12)
Sub Folder B (file_13, file_14)

------------------This happens------------------
file_13 __________ C:\Main Folder\Sub Folder B
file_14 __________ C:\Main Folder\Sub Folder B
file_11 __________ C:\Main Folder\Sub Folder A
file_12 __________ C:\Main Folder\Sub Folder A
file_1 __________ C:\Main Folder
file_2 __________ C:\Main Folder

------------------Required------------------
file_1 __________ C:\Main Folder
file_2 __________ C:\Main Folder
file_11 __________ C:\Main Folder\Sub Folder A
file_12 __________ C:\Main Folder\Sub Folder A
file_13 __________ C:\Main Folder\Sub Folder B
file_14 __________ C:\Main Folder\Sub Folder B

Can anyone amend the code as is.



Sub File_Attributes()
Dim sFolder As FileDialog
Set sFolder = Application.FileDialog(msoFileDialogFolderPicker)
If sFolder.Show = -1 Then
ListFiles sFolder.SelectedItems(1), True
End If
End Sub

Sub ListFiles(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)
Dim FSO, SourceFolder, SubFolder, FileItem As Object
Dim r As Long
Dim strFile As String
Dim FileName As Variant

Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
r = ActiveCell.Row
Application.ScreenUpdating = False

With CreateObject("Scripting.Dictionary")
For Each FileItem In SourceFolder.Files
strFile = FileItem.Name
.Item(strFile) = Array(FileItem.Name)
Next FileItem

For Each FileName In .Items
Rows(r).Insert
Cells(r, 3).Formula = FileName(LBound(FileName))
Cells(r, 6).Formula = SourceFolder.Path
r = r + 1
Next FileName

End With
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders: ListFiles SubFolder.Path, True: Next SubFolder
End If
Set FileItem = Nothing: Set SourceFolder = Nothing: Set FSO = Nothing
ActiveWorkbook.Saved = True: Application.ScreenUpdating = True
End Sub

[Kenneth Hobs]

I don't know that I would even rely on your "order" as you think of it.

Sort routines will sort by string or number. I wrote a routine once that allowed strings or numbers sorted to be listed 1st or 2nd.

In your case, it looks like you want to sort by the suffix number in the base filename. That could result in an unexpected outcome. e.g. Parent folder has file_1.xlsm while subfolder1 has file_1.xlsm as well.

In any case, I think that your best bet is to create a helper column for sorting purposes. The methods to get that suffix number can vary. If the filenames are always suffixed by an underscore character, that is easy enough. I have used this routine below though not "foolproof".


Sub Test_NumberPart2()
MsgBox NumberPart("-3,696 KB") '-3696
MsgBox NumberPart("ken_100") '100
MsgBox NumberPart("ken1_100") '1100
End Sub


' formula, http://office.microsoft.com/en-us/excel-help/extracting-numbers-from-alphanumeric-strings-HA001154901.aspx
' Modified by Kenneth Hobson
Function NumberPart(aString As String) As Double
Dim s As String, i As Integer, mc As String, mc2 As String
aString = Replace(aString, ",", "")
For i = 1 To Len(aString)
mc = Mid(aString, i, 1)
mc2 = ""
If i <> Len(aString) Then mc2 = Mid(aString, i + 1, 1)
If Not IsNumeric(mc2) Then mc2 = ""
If Asc(mc) >= 48 And Asc(mc) <= 57 _
Or (mc = "-" And mc2 <> "") _
Or (mc = "." And mc2 <> "") _
Then s = s & mc
Next i
NumberPart = s
End Function

Once you have your helper column, record a macro and sort and then modify accordingly.

[Indigenous]

Kenneth, with the above is it for filenames? I am happy with the way filenames are sorted. It's the folders that I need the macro to run through alphabetically. In my example "Sub Folder B" is processed before "Sub Folder A" but I need it the other way around. The part I am having issues with starts at:

If IncludeSubfolders Then
Also the same filename can be in multiple folders, both would get listed.

[snb]

sub M_snb()
sn=split(createobject("wscript.shell").exec("cmd /c dir C:\*.* /s /b /ad").stdout.readall,vbcrlf)
sheet1.cells(1).resize(ubound(sn))=application.transpose(sn)
end sub

[Indigenous]

snb, the above lists the folders how can I make it list the files. The "*.*" portion would not do this. Also would like folder dialogue "sFolder" to select directory.

[snb]

Why did you choose the alias 'Trying' ?

[Indigenous]

Fair enough.

[Kenneth Hobs]

My #2 solution was meant to allow you to use #1 in total. It simply gave you a means to solve your problem.


Kenneth, with the above is it for filenames? I am happy with the way filenames are sorted. It's the folders that I need the macro to run through alphabetically. In my example "Sub Folder B" is processed before "Sub Folder A" but I need it the other way around. The part I am having issues with starts at:
Obviously, it does not sort or you would not be posting here. Do you not understand how to sort by more than one column in Excel?


Also the same filename can be in multiple folders, both would get listed.
Again, so what? Just do what I said in #2 and sort by multiple columns as explained above.




snb, the above lists the folders how can I make it list the files. The "*.*" portion would not do this.
*.* is a wildcard that lists all files and folders. Just remove the /ad command parameter option that lists folders. For more information about the shell's Dir command see, http://ss64.com/nt/dir.html. I had already explained this in your thread, http://www.vbaexpress.com/forum/showthread.php?56017-Selective-listing-of-files-in-a-folder.


Also would like folder dialogue "sFolder" to select directory.
I don't know why you asked this. You obviously know how since you posted a method in your #1 and I showed you how in the link above. You can concatenate the folder name into snb's method or pass it in my aFFs() routine.

Obviously, if you use #4 without the /ad it will return the full drive:\folder\subfolers\filename.ext if at least one subfolder exists. My aFFs() routine in the reference link is similar to #2 though it does include full paths even if only the parent folder exists. Once you have all of that, you can use various methods such as fso to parse out the folder, base filename, and more.

I guess that we could do all of this for you but you learn more by "trying" to do it yourself.

[Kenneth Hobs]

As always, test on a backup copy.

Sub File_Attributes()
Dim sFolder As FileDialog
Dim r0 As Long, r1 As Long

r0 = ActiveCell.Row

Set sFolder = Application.FileDialog(msoFileDialogFolderPicker)
If sFolder.Show = -1 Then
ListFiles sFolder.SelectedItems(1), True
End If

With ActiveSheet
r1 = .UsedRange.Rows.Count + r0 - 1
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("F" & r0 & ":F" & r1) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("B" & r0 & ":B" & r1) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("C" & r0 & ":C" & r1) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange ActiveSheet.UsedRange
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
Columns("B:B").Delete Shift:=xlToLeft

ActiveSheet.UsedRange.Columns.AutoFit
End Sub

Sub ListFiles(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)
Dim fso, SourceFolder, SubFolder, FileItem As Object
Dim r As Long
Dim strFile As String
Dim FileName As Variant, fn As String

Set fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = fso.GetFolder(SourceFolderName)
r = ActiveCell.Row
Application.ScreenUpdating = False

With CreateObject("Scripting.Dictionary")
For Each FileItem In SourceFolder.Files
strFile = FileItem.Name
.Item(strFile) = Array(FileItem.Name)
Next FileItem

For Each FileName In .Items
Rows(r).Insert
fn = FileName(LBound(FileName))

If InStr(fn, "_") > 0 Then
Cells(r, "B").Value = NumberPart(fn)
Else
Cells(r, "B").Value2 = fn
End If

Cells(r, "C").Value2 = fn
Cells(r, "F").Value2 = SourceFolder.Path
r = r + 1
Next FileName
End With

If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFiles SubFolder.Path, True
Next SubFolder
End If

Set FileItem = Nothing: Set SourceFolder = Nothing: Set fso = Nothing
ActiveWorkbook.Saved = True: Application.ScreenUpdating = True

End Sub

' formula, http://office.microsoft.com/en-us/excel-help/extracting-numbers-from-alphanumeric-strings-HA001154901.aspx
' Modified by Kenneth Hobson
Function NumberPart(aString As String) As Double
Dim s As String, i As Integer, mc As String, mc2 As String

aString = Replace(aString, ",", "")

For i = 1 To Len(aString)
mc = Mid(aString, i, 1)
mc2 = ""
If i <> Len(aString) Then mc2 = Mid(aString, i + 1, 1)
If Not IsNumeric(mc2) Then mc2 = ""
If Asc(mc) >= 48 And Asc(mc) <= 57 _
Or (mc = "-" And mc2 <> "") _
Or (mc = "." And mc2 <> "") _
Then s = s & mc
Next i

NumberPart = s
End Function