'StrCmpLogicalW function
'https://docs.microsoft.com/en-us/windows/desktop/api/shlwapi/nf-shlwapi-strcmplogicalw
'
'Compares two Unicode strings. Digits in the strings are considered as numerical content rather than text. This test is not case-sensitive.
'Returns zero if the strings are identical.
'Returns 1 if string1 has a greater value than string2.
'Returns -1 if string1 has a lesser value than string2.
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL] VBA7 Then
Private Declare PtrSafe Function StrCmpLogicalW Lib "shlwapi.dll" (ByVal string1 As String, ByVal string2 As String) As Integer
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL]
Private Declare Function StrCmpLogicalW Lib "shlwapi.dll" (ByVal string1 As String, ByVal string2 As String) As Integer
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL] If
Public Sub Rename_Files_in_Folder()
Dim path As String, filename As String
Dim n As Long, m As Long
Dim files() As String, swap As String
path = "C:\path\to\folder" 'MODIFY THIS LINE - FOLDER CONTAINING FILES TO BE RENAMED
If Right(path, 1) <> "" Then path = path & ""
n = 0
filename = Dir(path & "*.*")
Do While filename <> vbNullString
ReDim Preserve files(n)
files(n) = filename
filename = Dir
n = n + 1
Loop
'Bubble sort files array, calling StrCmpLogicalW to compare Unicode strings numerically to sort the file names in
'the same order as File Explorer
For m = 0 To UBound(files) - 1
For n = m + 1 To UBound(files)
If StrCmpLogicalW(StrConv(files(m), vbUnicode), StrConv(files(n), vbUnicode)) = 1 Then
'files(m) > files(n) so swap them
swap = files(n)
files(n) = files(m)
files(m) = swap
End If
Next
Next
For n = 0 To UBound(files)
Name path & files(n) As path & String(n \ 26, "Z") & Chr(n Mod 26 + 65) & "_" & files(n)
Next
End Sub