Link to home
Start Free TrialLog in
Avatar of toverholt
toverholt

asked on

Access File List order by ascending help

I frequently use a scanner for records archiving.  I built a quick little DB for the purpose of renaming files, so they are useful to users without needing to give them a database.  As an example, I have copies of forms that are used for medical patients.  I scan the pages for each patient, which makes a PDF.  I then want to rename that file to the patients name, with date or anything else.

Using some code from Dev Ashish's website, I was able to make a nice form that can browse to a directory, list the files, I can pick one, it displays the PDF in a web control object, I can see what the content is and make a new name, which then automatically renames the file.  Works great.

There is one little issue....  The list of files is not alphabetical.  I am looking for someone to give me a code change that would order those files and the directory list if possible.  

Here is the code that I am using for this form:

Option Compare Database
Option Explicit

'--------------------------------------------------
' Updated By Mehmet Acikgoz (30 July 1998)
'--------------------------------------------------

' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of Dev Ashish
'

Dim mstPath As String
Dim mboolRoot As Boolean
Dim mstFilePath As String
Dim mboolClick As Boolean
Dim mboolUp As Boolean

Private Sub cmdNavUp_Click()
Dim stTmp As String
Dim I As Integer
    mboolUp = True
    If Len(mstPath) = 2 Then
        Me!lbxFiles.SetFocus
        Me!lbxFiles.RowSource = ""
        Me!lblPath.Caption = ""
        Me.Caption = "Explorer"
        Call sFillRoot
    Else
        For I = Len(mstPath) To 1 Step 0 - 1
            stTmp = Mid$(mstPath, I, 1)
            If stTmp = "\" Then
                mstPath = Left$(mstPath, I - 1)
                Call sNavigate(mstPath)
                Me!lbxFiles.Requery
                Exit For
            End If
        Next I
    End If
End Sub

Private Sub Command24_Click()
WB.Navigate URL:="c:\"
MsgBox "OK", vbApplicationModal

Name Forms!frmExplorer![Path] As Forms!frmExplorer![NewPath]

Forms!frmExplorer.Refresh


End Sub

Private Sub Form_Current()
'Navigate to the current record's Web site
'If there's no URL stored in the field, then display Google search engine.
   
   
            WB.Navigate URL:=Forms!frmExplorer![Path]
   
End Sub

Private Sub Form_Error(DataErr As Integer, Response As Integer)
    DoCmd.Hourglass False
End Sub

Private Sub Form_Open(Cancel As Integer)
    Call sFillRoot
    Me!lblPath.Caption = ""
   
   
   
End Sub

Private Sub sFillRoot()
Dim strAllDrives As String
Dim strTmp As String, strOut As String
Dim loDir As clsDir

    Set loDir = New clsDir
   
    strAllDrives = fGetDrives()
   
    strOut = vbNullString
   
    mboolRoot = True
   
    Do
        strTmp = Mid$(strAllDrives, 1, InStr(strAllDrives, vbNullChar) - 1)
        strAllDrives = Mid$(strAllDrives, InStr(strAllDrives, vbNullChar) + 1)
        strOut = strOut & strTmp & ";"
    Loop While strAllDrives <> ""
   
    'trim strOut
    strOut = Left$(strOut, Len(strOut) - 1)
   
    'populate the ListBox
    With Me!lbxFolders
        .RowSourceType = "Value List"
        .RowSource = strOut
    End With
   
    Me!cmdNavUp.Enabled = False
    Set loDir = Nothing
    mstPath = vbNullString

End Sub


Private Sub lbxFiles_AfterUpdate()

'Forms!frmExplorer![WB].Navigate2 Forms!frmExplorer![Path]

            WB.Navigate URL:=Forms!frmExplorer![Path]




End Sub

Private Sub lbxFiles_DblClick(Cancel As Integer)
Dim varRet
Dim stPath As String

    If mstPath = vbNullString Then
        stPath = Left$(Me!lbxFolders, Len(Me!lbxFolders) - 1)
    Else
        stPath = mstPath & "\" & Me!lbxFolders
    End If
    varRet = fHandleFile(stPath & "\" & Me!lbxFiles, WIN_NORMAL)
End Sub

Private Sub lbxFolders_Click()
    If mstPath = vbNullString Then
        mstFilePath = Left$(Me!lbxFolders, Len(Me!lbxFolders) - 1)
    Else
        mstFilePath = mstPath & "\" & Me!lbxFolders
    End If
    mboolClick = True:  mboolUp = False
    DoCmd.Hourglass True
    Me!lbxFiles.Requery
    DoCmd.Hourglass False
End Sub

Private Sub lbxFolders_DblClick(Cancel As Integer)
Dim stPath As String
Dim stOut As String
Dim stFiles As String
Dim I As Long
   
    If mstPath = vbNullString Then
        stPath = Left$(Me!lbxFolders, Len(Me!lbxFolders) - 1)
    Else
        stPath = mstPath & "\" & Me!lbxFolders
    End If
   
    mboolClick = False: mboolUp = False
    Me!lbxFiles.RowSource = ""
    Call sNavigate(stPath)
   
   
End Sub

Sub sNavigate(stPath As String)
Dim stFolders As String

    stFolders = fCreateFolderList(stPath)

    If stFolders <> vbNullString Then
        'Populate Folders List Box
        With Me!lbxFolders
            .RowSourceType = "Value List"
            .RowSource = stFolders
        End With
        mstPath = stPath
    Else
        mboolClick = False: mboolUp = False
        DoCmd.Hourglass True
        Me!lbxFiles.Requery
        DoCmd.Hourglass False
    End If
   
    Me!cmdNavUp.Enabled = (mboolRoot)
    Me.Caption = mstPath & "\ - Explorer"
    Me!lblPath.Caption = mstPath & "\"
End Sub

Function fListFill(ctl As Control, varID As Variant, lngRow As Long, _
                    lngCol As Long, intCode As Integer) As Variant

Static sastFiles() As String
Static slngCount As Long
Static sloclDir As clsDir
Dim I As Long
Dim varRet As Variant
Dim X As Long

    Select Case intCode
        Case acLBInitialize
            Set sloclDir = New clsDir
            If Not mstFilePath = vbNullString _
                        And mboolClick And Not mboolUp Then
                With sloclDir
                    .FillFiles mstFilePath
                   
                    slngCount = .GetFileCount
                   
                    If slngCount > 0 Then
                        ReDim sastFiles(0 To slngCount - 1)
                        For I = 1 To slngCount
                            sastFiles(I - 1) = .NameOfFile(I)
                        Next I
                        PDF_accSortStringArray sastFiles()
                    End If
                End With
            Else
                slngCount = 0
            End If
            varRet = True
           
        Case acLBOpen
            varRet = Timer

        Case acLBGetRowCount
            varRet = slngCount

        Case acLBGetValue
            If slngCount > 0 And mboolClick And Not mboolUp Then
                varRet = sastFiles(lngRow)
            Else
                varRet = vbNullString
            End If
           
        Case acLBEnd
            Set sloclDir = Nothing
            Erase sastFiles
    End Select
    fListFill = varRet
End Function

Private Sub Command25_Click()
On Error GoTo Err_Command25_Click


    DoCmd.Close

Exit_Command25_Click:
    Exit Sub

Err_Command25_Click:
    MsgBox Err.Description
    Resume Exit_Command25_Click
   
End Sub
ASKER CERTIFIED SOLUTION
Avatar of rockiroads
rockiroads
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Forced accept.

Computer101
EE Admin