?
Solved

Convert VB6 Listbox Sort to Array Sort...

Posted on 2006-05-31
11
Medium Priority
?
1,764 Views
Last Modified: 2008-01-09
I have the following code...


==========


Option Explicit

Private Sub cmdScan_Click(Index As Integer)
MsgBox "Working on file " & cmdScan(Index).Caption
End Sub

Private Sub Command1_Click()
    Dim ScanYear As String
    Dim ScanFormat  As String
    Dim ScanPath  As String
    Dim ScanMaxDocs  As String
    Dim ScanReference As String
    Dim strFileName As String
    Dim i As Integer
    Dim strScans() As String
   
    ScanYear = "2006"
    ScanFormat = ".pdf"
    ScanPath = "C:\Scans\"
    ScanMaxDocs = "6" '(this is currently the maxiumum pages to a series of documents)
    ScanReference = "12345678"
    Me.List1.Clear
    For i = 0 To 5
        cmdScan(i).Visible = False
    Next i
    strFileName = Dir$(ScanPath & ScanReference & "-" & ScanYear & "-" & "*" & ScanFormat)
    Do Until strFileName = ""
        List1.AddItem strFileName
        strFileName = Dir$()
    Loop
    For i = 0 To List1.ListCount - 1
        cmdScan(i).Visible = True
        cmdScan(i).Caption = List1.List(i)
    Next i
End Sub

Private Sub Form_Load()
Dim i As Integer
    Me.List1.Clear 'Me means this Form. It can be omitted here.
    For i = 0 To 5
        Me.cmdScan(i).Visible = False
    Next i
End Sub


==========


I'd like some help converting this to an access "safe" array sort rather than a sort in a listbox.

Many thanks!
0
Comment
Question by:ukkrew
  • 7
  • 4
11 Comments
 
LVL 65

Expert Comment

by:rockiroads
ID: 16800126
something like this perhaps


Private Sub Command1_Click()
   
    Dim ScanYear As String
    Dim ScanFormat  As String
    Dim ScanPath  As String
    Dim ScanMaxDocs  As String
    Dim ScanReference As String
    Dim strFileName As String
    Dim i As Integer
    Dim strScans() As String
    Dim bLoop As Boolean
   
    ScanYear = "2006"
    ScanFormat = ".pdf"
    ScanPath = "C:\Scans\"
    ScanMaxDocs = "6" '(this is currently the maxiumum pages to a series of documents)
    ScanReference = "12345678"
   
    Dim sDocs(MAX_DOCS)
    'Initialise
    For i = 0 To UBound(sDocs)
        cmdScan(i).Visible = False
    Next i
   
    strFileName = Dir$(ScanPath & ScanReference & "-" & ScanYear & "-" & "*" & ScanFormat)
   
    i = 0
    bLoop = True
    Do While bLoop = True
        If strFileName = "" Then
            bLoop = False
        ElseIf i > UBound(sDocs) Then  'no more room
            MsgBox "No More Room"
            bLoop = False
        Else
            sDocs(i) = strFileName
        End If
        strFileName = Dir$()
        i = i + 1
    Loop
   
    For i = 0 To UBound(sDocs)
        cmdScan(i).Visible = True
        cmdScan(i).Caption = sDocs(i)
    Next i
End Sub
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 16800127
forgot Const MAX_DOCS = 6


alternative is to use a collections class
but above is easy enough
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 16800163
oh, your code, I forgot u cannot have array of controls, it has to be individual controls

plus I forgot the constants

say u names your command buttons

cmdScan0,cmdScan1,cmdScan2,...cmdScan5

Const MAX_DOCS = 6  '(this is currently the maxiumum pages to a series of documents)
Dim sDocs() As String


Private Sub Command1_Click()
   
    Dim ScanYear As String
    Dim ScanFormat  As String
    Dim ScanPath  As String
    Dim ScanReference As String
    Dim strFileName As String
    Dim i As Integer
    Dim strScans() As String
    Dim bLoop As Boolean
   
    ScanYear = "2006"
    ScanFormat = ".pdf"
    ScanPath = "C:\Scans\"
    ScanReference = "12345678"
   
    'Initialise
    For i = 0 To MAX_DOCS - 1
        Me("cmdScan" & i).Visible = False
    Next i
   
    strFileName = Dir$(ScanPath & ScanReference & "-" & ScanYear & "-" & "*" & ScanFormat)
   
    i = 0
    bLoop = True
    Do While bLoop = True
        If strFileName = "" Then
            bLoop = False
        ElseIf i > UBound(sDocs) Then  'no more room
            MsgBox "No More Room"
            bLoop = False
        Else
            sDocs(i) = strFileName
        End If
        strFileName = Dir$()
        i = i + 1
    Loop
   
    For i = 0 To MAX_DOCS - 1
        Me("cmdScan" & i).Visible = True
        Me("cmdScan" & i).Caption = sDocs(i)
    Next i
End Sub

Private Sub Form_Load()
    Dim i As Integer
   
    ReDim sDocs(MAX_DOCS)
   
    For i = 0 To MAX_DOCS - 1
        Me("cmdScan" & i).Visible = False
    Next i
End Sub


0
Granular recovery for Microsoft Exchange

With Veeam Explorer for Microsoft Exchange you can choose the Exchange Servers and restore points you’re interested in, and Veeam Explorer will present the contents of those mailbox stores for browsing, searching and exporting.

 

Author Comment

by:ukkrew
ID: 16801034
thanks, rockiroads...

I'm getting a few errors trying out the code...

if no files / directory not found, i get: run time error 5

if files exist (tried with 1), i get: run time error 9

any ideas?

Many thanks.
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 16801451
no files

ok, check for file before loop i.e.

strFileName = Dir$(ScanPath & ScanReference & "-" & ScanYear & "-" & "*" & ScanFormat)

if strFileName <> "" then

    i = 0
    bLoop = True
    Do While bLoop = True
        If strFileName = "" Then
            bLoop = False
        ElseIf i > UBound(sDocs) Then  'no more room
            MsgBox "No More Room"
            bLoop = False
        Else
            sDocs(i) = strFileName
        End If
        strFileName = Dir$()
        i = i + 1
    Loop
end if

0
 
LVL 65

Accepted Solution

by:
rockiroads earned 2000 total points
ID: 16801529
I am used to using Dir when I used VB long time ago, but it dont always seem to work with Access VBA, I dont know why
so here is an alternative

note, we can also get rid of sDocs if u set the caption within the loop



Private Const MAX_PATH = 260

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type

Private Declare Function FindClose Lib "kernel32" _
  (ByVal hFindFile As Long) As Long
   
Private Declare Function FindFirstFile Lib "kernel32" _
    Alias "FindFirstFileA" _
  (ByVal lpFileName As String, _
    lpFindFileData As WIN32_FIND_DATA) As Long
   
Private Declare Function FindNextFile Lib "kernel32" _
    Alias "FindNextFileA" _
  (ByVal hFindFile As Long, _
    lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function GetTickCount Lib "kernel32" () As Long


Private Sub Command1_Click()
   
    Dim ScanYear As String
    Dim ScanFormat  As String
    Dim ScanPath  As String
    Dim ScanMaxDocs  As String
    Dim ScanReference As String
    Dim strFileName As String
    Dim i As Integer
    Dim strScans() As String
    Dim bLoop As Boolean
    Dim WFD As WIN32_FIND_DATA
    Dim hFile As Long
    Dim sPath As String
    Dim sRoot As String
    Dim sTmp As String
   
   
    ScanYear = "2006"
    ScanFormat = ".pdf"
    ScanPath = "C:\Scans\"
    ScanMaxDocs = "6" '(this is currently the maxiumum pages to a series of documents)
    ScanReference = "12345678"
   
    'Initialise
    For i = 0 To MAX_DOCS - 1
        Me("cmdScan" & i).Visible = False
    Next i
   
    sPath = ScanPath & ScanReference & "-" & ScanYear & "-" & "*" & ScanFormat
    MsgBox "Checking for " & sPath
   
    hFile = FindFirstFile(sPath, WFD)
    i = 0
    If hFile <> INVALID_HANDLE_VALUE Then
        Do
            'here is filename
            sDocs(i) = TrimNull(WFD.cFileName)
           
            'You can get rid of sDocs altogether if u just do this
            Me("cmdScan" & i).Caption = TrimNull(WFD.cFileName)
           
            i = i + 1
            If i = MAX_DOCS - 1 Then
                MsgBox "No More Room"
            End If
        Loop While FindNextFile(hFile, WFD)
       
        hFile = FindClose(hFile)
    End If
   
    'This is redundant if u set caption within loop
    For i = 0 To MAX_DOCS - 1
        Me("cmdScan" & i).Visible = True
        Me("cmdScan" & i).Caption = sDocs(i)
    Next i

End Sub

Private Function TrimNull(item As String)

   Dim iPos As Integer
   
   iPos = InStr(item, Chr$(0))
   If iPos Then TrimNull = Left$(item, iPos - 1) Else TrimNull = item
   
End Function




0
 

Author Comment

by:ukkrew
ID: 16803115
Thats great!!

The only problem now appears to be with making the buttons visible and invisible... it just doesn't seam to work?

Many thanks!!
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 16805012
ok, how do u want the buttons displayed?

are there always 6 documents therefore always 6 buttons displayed?

if so, then why is there code that initially hides the buttons

Or do the number vary, in that case what/when/how do u want buttons displayed

Ive done it to your code logic, but if u tell me in general what u want doing then we can address it
0
 

Author Comment

by:ukkrew
ID: 16805598
Not a problem rockiroads,

What i'd like is to have all the buttons initally invisible, then as the code loops through, i'd like to only make the buttons with a caption (where a file is found) made visible... Its just to try and keep things as simple as possible for the user.

Is it also possible to have some code like:

    If i = 1 Then
        ScanMsg.Caption = "There is one file in the folder"
    Else
        ScanMsg.Caption = "There are " & i & " files in the folder"
    End If

I tried putting this in, but it appears that i = 1 even when 0 files are found?

Many thanks.
0
 

Author Comment

by:ukkrew
ID: 16805803
don't worry rockiroads, i sussed it.

Thanks for the help!!
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 16808642
sorry, when at work I dont get notifications as I cant check my personal email

So I see u sussed it, cool

Hopefully wasnt a big deal

0

Featured Post

Transaction-level recovery for Oracle database

Veeam Explore for Oracle delivers low RTOs and RPOs with agentless transaction log backup and transaction-level recovery of Oracle databases. You can restore the database to a precise point in time, even to a specific transaction.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Did you know that more than 4 billion data records have been recorded as lost or stolen since 2013? It was a staggering number brought to our attention during last week’s ManageEngine webinar, where attendees received a comprehensive look at the ma…
This article shows how to get a list of available printers for display in a drop-down list, and then to use the selected printer to print an Access report or a Word document filled with Access data, using different syntax as needed for working with …
Add bar graphs to Access queries using Unicode block characters. Graphs appear on every record in the color you want. Give life to numbers. Hopes this gives you ideas on visualizing your data in new ways ~ Create a calculated field in a query: …
Do you want to know how to make a graph with Microsoft Access? First, create a query with the data for the chart. Then make a blank form and add a chart control. This video also shows how to change what data is displayed on the graph as well as form…
Suggested Courses

831 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