2

使用しているアプリケーションに問題があります。選択したフォルダ内のすべての画像とフォルダ内のサブフォルダの名前を変更するアプリです。

ただし、画像をアルファベット順AZで処理する場合もあるため、名前を正しく変更したり、日付変更順で処理しているように見える場合もあります。最初に最も古く、最後に最も新しい。これにより、ファイルの順序が間違ってしまいます。同じPCで両方の結果が得られたので、次に何を試すかについて完全に混乱しています。

常にアルファベット順の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\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

どんな助けでも本当にありがたいです。

よろしく、

サム

4

1 に答える 1

0

したがって、このリンクには、@ 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
于 2013-04-10T13:16:53.950 に答える