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 功能会对列表进行排序，为您提供最小值和最大值。
其次， sortedfiles 作为主要文件将按字母顺序返回文件列表。

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

。

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

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

1 个答案: