vba - 强制文件和文件夹按字母顺序处理

Question

我的应用程序有问题。这是一个重命名所选文件夹中的所有图片和文件夹内的子文件夹的应用程序。

然而，有时它按字母顺序 A-Z 处理图片，因此正确地重命名它们，有时它似乎按日期修改顺序处理它们。最旧的在前，最新的在后。这会导致文件的顺序错误。我们在同一台 PC 上获得了这两个结果，我完全不知道接下来要尝试什么。

有谁知道如何更改以下代码，使其始终使用字母顺序 A-Z。

请帮忙。

完整代码如下: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

任何帮助将非常感激。

问候，

山姆

Answer 1

所以在 this link ，正如@SkipIntro 所提供的，有一个函数和一个子函数。

首先是 快速排序 如果您提供最小值和最大值，函数将对列表进行排序。

其次是已排序文件 作为主要的将按字母顺序返回文件列表。

如果您在发布之前使用以下内容对文件名进行排序，那么它们将按字母顺序排列，例如

quicksort myfilenames, 1, ubound(myfilenames, 1)     

快速排序:

' 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