Solved

Access File List order by ascending help

Posted on 2007-11-23
3
1,644 Views
Last Modified: 2013-11-27
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
0
Comment
Question by:toverholt
3 Comments
 
LVL 65

Accepted Solution

by:
rockiroads earned 500 total points
ID: 20340737
Well what you could try is do your bit above then when listbox is built up is to sort the values

Ive created sample code below which takes values from a listbox called lstMyBox, places them in an array. It then sorts this array and finally puts the value back
into the listbox

Create this as a seperate procedure as its best to keep this as an option


    Dim arraySize As Integer
   
    arraySize = lstMyBox.ListCount - 1
    Dim items() As String
   
    ReDim items(arraySize)
    Dim i As Integer
    Dim j As Integer
    Dim tmp As String
   
    'Save items to array
    For i = 0 To arraySize
        items(i) = lstMyBox.ItemData(i)
    Next i
   
    'Now sort
    For i = 0 To arraySize - 1
        For j = i To arraySize
            If items(i) > items(j) Then
                tmp = items(i)
                items(i) = items(j)
                items(j) = tmp
            End If
        Next j
    Next i
   
    'Rebuild list
    lstMyBox.RowSource = ""
    For i = 0 To arraySize
        If lstMyBox.RowSource <> "" Then lstMyBox.RowSource = lstMyBox.RowSource & ","
        lstMyBox.RowSource = lstMyBox.RowSource & items(i)
    Next i


0
 
LVL 1

Expert Comment

by:Computer101
ID: 21339185
Forced accept.

Computer101
EE Admin
0

Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

This script will sweep a range of IP addresses (class c only, 255.255.255.0) and report to a log the version of office installed. What it does: 1.)      Creates log file in the directory the script is run from (if it doesn't already exist) 2.)      Sweep…
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
Learn how to number pages in an Access report over each group. Activate two pass printing by referencing the pages property: Add code to the Page Footers OnFormat event to capture the pages as there occur for each group. Use the pages property to …
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now