Results 1 to 2 of 2
  1. #1
    Platinum Lounger
    Join Date
    Feb 2001
    Location
    Yilgarn region of Toronto, Ontario
    Posts
    5,453
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Code: Function lngLoadList(frmMe As UserForm, lb A

    I have re-written my generic "Load-A-ListBox with files" procedure.

    This procedure makes use of two other procedures : lngAddToListBox and strSplitStringAt, although you don't need strSplitStringAt if you don't ever plan to recurse, or you could store the names in a local array. I wrote this initial code in WordBasic before I knew of arrays.

    You could roll your own lngAddToListBox if you want. It's pretty well a one-line function (lb.add(strtext)).

    I like my rewritten version because:

    1) It takes a Userform as an argument, so this procedure can be stored as a public procedure in my utility library (module U of template Utils.dot); it doesn' need to be duplicated as a Private procedure in each user form.

    2) It takes a ListBox as an argument, so I can populate several listboxes on one form quite easily.

    3) It takes a generic name and extent so that I can load files that match a specific pattern. My frmIcons Userform asks for all icon files (*.ICO) whereas my Document Cleanser asks for all files thst start RoR (ROR*.DOC).

    4) It is recursive, thereby removing "Wuss" from my string of nicknames. (grin!)



    In a reply to THIS post I will post instructions for using/testing this code.

    <pre>Public Function lngLoadList(frmMe As UserForm, lb As ListBox, _
    strPath As String, strName As String, strExtent As String,_
    boolRecurse As Boolean) As Long
    ' Procedure : lngLoadList
    ' Description: Load a listbox from a file/path/extent specification.
    ' Copyright: Chris Greaves Inc.
    ' Inputs: Userform, Listbox, Path, Name, Extent and recursion flag.
    ' Userform - The form containing the listbox to be loaded.
    ' Listbox - The listbox to be loaded.
    ' Path - Path of parent directory, optinal trailing path separator.
    ' Name - Generic name of files being sought; "RoR" will find "RoR*.*.
    ' Extent - Generic extent of files being sought;
    ' "DO" will find "*.DOt" and "*.DOc".
    ' Recursion flag - if TRUE we will search all child directories.
    ' Returns: LONG count of items in the listbox.
    ' Assumes: None.
    ' Side Effects: None.
    ' Tested: By the calls shown below.

    ' Attach a trailing path separator ("") if one is not present
    Dim strLocPath As String
    If Right(strPath, 1) = Application.PathSeparator Then
    strLocPath = strPath
    Else
    strLocPath = strPath & Application.PathSeparator
    End If

    Dim strFile As String ' holds successive results of the DIR operation - found files.

    Dim strDirs As String ' holds a string of directories at this level.
    frmMe.Caption = "Searching in " & strLocPath: frmMe.Repaint

    ' FIRST: Are we asked to search directories below this directory?
    If boolRecurse Then
    ' Prepare search for all directory files at this level.
    strFile = Dir(strLocPath & "*.*", vbDirectory)
    While strFile <> "" ' Until DIRECTORY search is exhausted.
    On Error GoTo Failed1
    If (GetAttr(strLocPath & strFile) And vbDirectory) = vbDirectory Then
    ' Ignore current and parent directories.
    If strFile <> strcExtentSeparator And strFile <> ".." Then
    ' Append this directory to the list of directories at this level.
    strDirs = strDirs & strLocPath & strFile & ","
    Else
    End If
    Else
    End If
    Failed1:
    On Error GoTo 0
    strFile = Dir ' get next DIRECTORY result at this level
    Wend
    Else
    End If

    ' SECOND: Obtain all matching files at the current level.
    strFile = Dir(strLocPath & strName & "*." & strExtent & "*", vbDirectory)
    While strFile <> "" ' Until FILE search is exhausted.
    On Error GoTo Failed2
    If (GetAttr(strLocPath & strFile) And vbDirectory) <> vbDirectory Then
    Call lngAddToListBox(lb, strLocPath & strFile)
    Else
    End If
    Failed2:
    On Error GoTo 0
    strFile = Dir ' get next FILE result at this level
    Wend

    ' THIRD: Process all found directories at this path (recurse)
    While Len(strDirs) > 0
    Dim strThisDir As String
    ' get next substring
    strThisDir = strSplitStringAt(strDirs, Right(strDirs, 1), True)
    ' drop that substring
    strDirs = strSplitStringAt(strDirs, Right(strDirs, 1), False)
    Call lngLoadList(frmMe, lb, strThisDir, strName, strExtent, boolRecurse)
    Wend

    lngLoadList = lb.ListCount
    End Function
    </pre>


  2. #2
    Platinum Lounger
    Join Date
    Feb 2001
    Location
    Yilgarn region of Toronto, Ontario
    Posts
    5,453
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Code: Function lngLoadList(frmMe As UserForm, lb A

    To make use of the lngLoadList procedure you will need two slave functions lngAddToList and strSplitStringAt, pasted below.

    In VBE choose Insert, UserForm. Use the toolbox to make a listbox (ListBox1) and a command button (CommandButton1) on that form.

    Double-click on the command button and code the procedure like this:

    <pre>Private Sub CommandButton1_Click()
    MsgBox lngLoadList(Me, Me.ListBox1, "c:greaves", "d", "do", True) & " files were found"
    ' Call SortListBox(Me.ListBox1, 0) ' You don't have my SortListBox procedure.
    End Sub
    </pre>


    This should cause the command button to hunt for files "c:greavesD*.DO*" in c:Greaves and all subdirectories of c:greaves.

    Click on the form and then tap the F5 function key. When the GUI pops up, click on the CommandButton.

    <pre>Public Function lngAddToListBox(lb As ListBox, strCaption As String) As Long
    ' Procedure: lngAddToListBox
    ' Description: Add a string to a named list box.
    ' Copyright: Chris Greaves Inc.
    ' Inputs: The listbox, the string to be loaded.
    ' Returns: LONG new size of listbox.
    ' Assumes: None.
    ' Side Effects: None.
    ' Tested: by the calls shown below.
    lb.AddItem
    lb.List(lb.ListCount - 1, 0) = strCaption
    lngAddToListBox = lb.ListCount - 1
    End Function


    Public Function strSplitStringAt(strIN As String, strDelim As String, boolDirection As Boolean)
    ' Procedure : strSplitStringAt
    ' Description: Return the leading or trailing portion of a string.
    ' Copyright: Chris Greaves Inc.
    ' Inputs: A string.
    ' A delimiter character.
    ' A directional flag True==>leading string
    ' Returns: A sub-string of the original string.
    ' Assumes: None.
    ' Side Effects: None.
    ' Tested: By the calls shown below.
    ' If the delimiter is found TRUE returns the first sub-string
    ' If the delimiter is found FALSE returns all but the first sub-string
    ' If the delimiter is not found TRUE returns the original string
    ' If the delimiter is not found FALSE returns the empty string
    Dim lngI As Long
    If strDelim = "" Then
    strSplitStringAt = ""
    Else
    lngI = InStr(1, strIN, Left(strDelim, 1))
    If lngI > 0 Then
    If boolDirection Then
    strSplitStringAt = Left(strIN, lngI - 1)
    Else
    strSplitStringAt = Right(strIN, Len(strIN) - lngI)
    End If
    Else
    If boolDirection Then
    strSplitStringAt = strIN
    Else
    strSplitStringAt = ""
    End If
    End If
    End If
    'Sub TESTstrSplitStringAt()
    'MsgBox strSplitStringAt("here,is,a,string", ",", True) ' "here"
    'MsgBox strSplitStringAt("here,is,a,string", ",", False) ' "is,a,string"
    'MsgBox strSplitStringAt("string", ",", True) ' "string"
    'MsgBox strSplitStringAt("string", ",", False) ' ""
    'End Sub
    End Function
    </pre>


Posting Permissions

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