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

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

然而，有时它会按字母顺序处理图片AZ，因此正确地重命名它们，有时似乎是在修改date的顺序中处理它们。 最早的，最新的。 这会导致文件的顺序错误。 我们在同一台个人电脑上看到了两个结果，我对接下来的尝试感到十分困惑。

有谁知道如何改变下面的代码，以便它总是使用字母顺序AZ。

请帮忙。

完整的代码如下：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\ABC\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

所以在这个链接 ，由@SkipIntro提供，有一个函数和一个子。

• 首先， 快速sortingfunction将sorting一个列表，为您提供最小值和最大值。

• 其次，主要的sorting文件将按字母顺序返回文件列表。

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

 quicksort myfilenames, 1, ubound(myfilenames, 1) 

快速sorting：

 ' 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