Consulting

Results 1 to 2 of 2

Thread: Solved: vba dir() need sorting by filename

  1. #1

    Solved: vba dir() need sorting by filename

    FNames = Dir("order*.xls")
    If Len(FNames) = 0 Then
    MsgBox "No files in the Directory"
    ChDrive SaveDriveDir
    ChDir SaveDriveDir
    Exit Sub
    End If

    How to get FNames sorted?

  2. #2
    Administrator
    VP-Knowledge Base
    VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    [vba]
    Option Explicit
    Sub Testing()
    Dim FNames As String
    Dim arr()
    Dim i As Long, j As Long

    ReDim arr(1000) 'set greater than possible number of files
    FNames = Dir("C:\*.xls") 'set your own path
    Do Until FNames = ""
    arr(i) = FNames
    i = i + 1
    FNames = Dir
    Loop
    ReDim Preserve arr(i)
    QuickSort arr(), LBound(arr), UBound(arr)
    For j = 0 To i
    Cells(j + 1, 2) = arr(j)
    Next

    End Sub


    Private Sub QuickSort(strArray(), intBottom As Integer, intTop As Integer)
    Dim strPivot As String, strTemp As String
    Dim intBottomTemp As Integer, intTopTemp As Integer
    intBottomTemp = intBottom
    intTopTemp = intTop
    strPivot = strArray((intBottom + intTop) \ 2)
    While (intBottomTemp <= intTopTemp)
    While (strArray(intBottomTemp) < strPivot And intBottomTemp < intTop)
    intBottomTemp = intBottomTemp + 1
    Wend
    While (strPivot < strArray(intTopTemp) And intTopTemp > intBottom)
    intTopTemp = intTopTemp - 1
    Wend
    If intBottomTemp < intTopTemp Then
    strTemp = strArray(intBottomTemp)
    strArray(intBottomTemp) = strArray(intTopTemp)
    strArray(intTopTemp) = strTemp
    End If
    If intBottomTemp <= intTopTemp Then
    intBottomTemp = intBottomTemp + 1
    intTopTemp = intTopTemp - 1
    End If
    Wend
    'the function calls itself until everything is in good order
    If (intBottom < intTopTemp) Then QuickSort strArray, intBottom, intTopTemp
    If (intBottomTemp < intTop) Then QuickSort strArray, intBottomTemp, intTop
    End Sub
    [/vba]
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •