• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1770
  • Last Modified:

Convert VB6 Listbox Sort to Array Sort...

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
ukkrew
Asked:
ukkrew
  • 7
  • 4
1 Solution
 
rockiroadsCommented:
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
 
rockiroadsCommented:
forgot Const MAX_DOCS = 6


alternative is to use a collections class
but above is easy enough
0
 
rockiroadsCommented:
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
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
ukkrewAuthor Commented:
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
 
rockiroadsCommented:
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
 
rockiroadsCommented:
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
 
ukkrewAuthor Commented:
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
 
rockiroadsCommented:
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
 
ukkrewAuthor Commented:
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
 
ukkrewAuthor Commented:
don't worry rockiroads, i sussed it.

Thanks for the help!!
0
 
rockiroadsCommented:
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

  • 7
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now