按字母顺序排序列表框中的文件而不是数字排序

时间:2016-10-05 09:59:41

标签: vba ms-word word-vba

我正在尝试按特定顺序将文件夹中的文件列表添加到列表框中。 目前,我基于数字标签在资源管理器视图中对文件进行排序,然后重命名每个文件,以便将它们命名为a(1).docx,a(2).docx,a(3).docx等。当我点击(10).docx和(11).docx时我的问题就出现了,因为排序是字母而不是数字。当文件进入列表框时,它们按照(1),a(10),a(11),a(12)等顺序排列。 有没有更简单的方法来克服这个排序问题? 请参阅下面的代码摘录

Private Sub GetFiles(strFolder As String)
    If Right(strFolder, 1) <> Chr(92) Then strFolder = strFolder & Chr(92)
    On Error GoTo lbl_Exit:
    sName = Dir$(strFolder)
    Me.ListFiles.Clear          'ListFiles is my listbox
    Do While sName <> ""
        AddItems Me.ListFiles, sName, strFolder
        sName = Dir$
    Loop
lbl_Exit:
    Exit Sub
End Sub

1 个答案:

答案 0 :(得分:1)

我看到问题解决的最简单方法是将docx文件命名为a(01),a(02)等。这样您的代码就可以按预期工作。至少对我来说;)

马库斯

好的,所以,如果重命名不是一个选项,我想出的代码:

Private Sub GetFiles(strFolder As String)

    Dim DirArray() As Variant
    ReDim Preserve DirArray(0 To 0) As Variant

    Me.ListFiles.Clear

    '---- Get the filenames into an array ----
    Dim sFileName As String
    sFileName = Dir$(strFolder)

    Do While sFileName <> vbNullString

        DirArray(UBound(DirArray)) = sFileName

        sFileName = Dir$

        If sFileName <> vbNullString Then
            ReDim Preserve DirArray(0 To UBound(DirArray) + 1) As Variant
        End If
    Loop

    '---- Sort the array ----
    Dim i As Integer
    Dim j As Integer

    Dim CompareTemp1 As String
    Dim CompareTemp2 As String

    For i = LBound(DirArray) To UBound(DirArray)
        For j = i To UBound(DirArray)

            '---- Compare two neighbouring filename-numbers
            '---- If the one lower in the list has a lower number, they'll be switched around ----
            If GetNumbersFromFileName(CStr(DirArray(j))) < GetNumbersFromFileName(CStr(DirArray(i))) Then

                '---- Change the neighbouring filenames order ----
                CompareTemp1 = DirArray(i)
                CompareTemp2 = DirArray(j)
                DirArray(i) = CompareTemp2
                DirArray(j) = CompareTemp1

           End If
        Next j
    Next i
    '---- Once all this is done, the DirArray should have the desired order, with the undesireables on top ----

    '---- Display the new filename-order in your ListBox ----
    For i = 0 To UBound(DirArray) - 1

        '---- Display only filenames with (##) ----
        If GetNumbersFromFileName(CStr(DirArray(i))) <> -1 Then
            AddItems Me.ListFiles, (CStr(DirArray(i))), strFolder
        End If

    Next i

    ReDim DirArray(0) As Variant

End Sub

Private Function GetNumbersFromFileName(sFileNameToCheck As String) As Integer

    Dim iOpenBracketPosition As Integer
    Dim iClosedBracketPosition As Integer

    '---- Get the bracket-positions ----
    iOpenBracketPosition = InStr(1, sFileNameToCheck, "(")
    iClosedBracketPosition = InStr(1, sFileNameToCheck, ")")

    '---- In case one of the brackets is missing, the file will be pushed to the top ----
    If iOpenBracketPosition = 0 Or iClosedBracketPosition = 0 Then
        GetNumbersFromFileName = -1
        Exit Function
    End If

    '---- Return the Number in between the brackets ----
    GetNumbersFromFileName = CInt(Mid$(sFileNameToCheck, iOpenBracketPosition + 1, iClosedBracketPosition - iOpenBracketPosition - 1))

End Function

希望有道理! 干杯! 马库斯

相关问题