Forcing files and folders to be dealt with in alph

Question

I have a problem with a application that I have. It is a app to rename all pictures in a selected folder and the sub folders within the folder.

However sometimes it deals with the pictures in alphabetical order A-Z, therefore renaming them correctly and sometimes it seems to be dealing with them in Date Modified Order. Oldest first, newest last. This causes the order of the files to become wrong. We have had both results on the same PC and I am totally confused on what to try next.

Does anyone know how to alter the below code so that it always uses alphabetical order A-Z.

Please help.

The full code is as follows: SUB1

   Sub TestListFilesInFolder()
'Workbooks.Add ' create a new workbook for the file list
' add headers

Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = strPath
    If .Show <> -1 Then
        sItem = "No item selected"
    Else
        sItem = .SelectedItems(1)
    End If
End With

With Range("A1")
    .Formula = "Folder contents:"
    .Font.Bold = True
    .Font.Size = 12
End With
Range("A3").Formula = "Old File Path:"
Range("B3").Formula = "File Type:"
Range("C3").Formula = "File Name:"
Range("D3").Formula = "New File Path:"
Range("A3:H3").Font.Bold = True
'ListFilesInFolder "L:\Pictures\A B C\B526 GROUP", True
ListFilesInFolder sItem, True

' list all files included subfolders
   End Sub

SUB2

    Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
   ' lists information about the files in SourceFolder
   ' example: ListFilesInFolder "C:\FolderName", True
    Dim fso As Object
   Dim SourceFolder As Object, SubFolder As Object
   Dim FileItem As Object
   Dim r As Long, p As Long
   Dim fPath As String, fName As String, oldName As String, newName As String
   Dim strVal As String, strVal2 As String, strVal3 As String, strVal4 As String, iSlashPos As Integer

Set fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = fso.GetFolder(SourceFolderName)
r = Range("A65536").End(xlUp).Row + 1
p = 1
For Each FileItem In SourceFolder.Files
    ' display file properties
    Cells(r, 1).Formula = FileItem.Path
    fFile = FileItem.Path
    Cells(r, 2).Formula = FileItem.Type
    Cells(r, 3).Formula = FileItem.Name
    fName = FileItem.Name
  If FileItem.Type = "JPEG Image" Then
    oldName = Left(FileItem.Name, InStrRev(FileItem.Name, ".") - 1)
    fPath = Left(FileItem.Path, InStrRev(FileItem.Path, "\") - 1)

    strVal = fPath
    Dim arrVal As Variant
    arrVal = Split(strVal, "\")
    strVal2 = arrVal(UBound(arrVal))
    strVal3 = arrVal(UBound(arrVal) - 1)

    newName = Replace(FileItem.Name, oldName, strVal3 & "_" & strVal2 & "_" & "Pic" & p & "_" & Format(Date, "ddmmyyyy"))

    Name fFile As fPath & "\" & newName
    Cells(r, 4).Formula = fPath & "\" & newName
    p = p + 1
    Else
    End If

    r = r + 1 ' next row number
Next FileItem
If IncludeSubfolders Then
    For Each SubFolder In SourceFolder.subfolders
        ListFilesInFolder SubFolder.Path, True
    Next SubFolder
End If
Columns("A:H").AutoFit
Set FileItem = Nothing
Set SourceFolder = Nothing
Set fso = Nothing
ActiveWorkbook.Saved = True
Set fldr = Nothing
    End Sub

Any help would be really appreciated.

Regards,

Sam

Answer 1

So in this link, as provided by @SkipIntro, there is a function and a sub.

• Firstly the quicksort function will sort a list providing you supply the min and max.

• Secondly the sortedfiles being the main one will return the list of files in alphabetical order.

If you use the following to sort you file names before they are published then they will be in alphabetical order e.g.

quicksort myfilenames, 1, ubound(myfilenames, 1)     

quicksort:

' Use Quicksort to sort a list of strings. 
' 
' This code is from the book "Ready-to-Run 
' Visual Basic Algorithms" by Rod Stephens. 
' http://www.vb-helper.com/vba.htm 
Private Sub Quicksort(list() As String, ByVal min As Long, ByVal max As Long) 
Dim mid_value As String 
Dim hi As Long 
Dim lo As Long 
Dim i As Long

' If there is 0 or 1 item in the list, 
' this sublist is sorted. 
If min >= max Then Exit Sub

' Pick a dividing value. 
i = Int((max - min + 1) * Rnd + min) 
mid_value = list(i)

' Swap the dividing value to the front. 
list(i) = list(min)

lo = min 
hi = max 
Do 
' Look down from hi for a value < mid_value. 
Do While list(hi) >= mid_value 
hi = hi - 1 
If hi <= lo Then Exit Do 
Loop 
If hi <= lo Then 
list(lo) = mid_value 
Exit Do 
End If

' Swap the lo and hi values. 
list(lo) = list(hi)

' Look up from lo for a value >= mid_value. 
lo = lo + 1 
Do While list(lo) < mid_value 
lo = lo + 1 
If lo >= hi Then Exit Do Loop 
If lo >= hi Then 
lo = hi 
list(hi) = mid_value 
Exit Do 
End If

' Swap the lo and hi values. 
list(hi) = list(lo) 
Loop

' Sort the two sublists. 
Quicksort list, min, lo - 1 
Quicksort list, lo + 1, max 
End Sub