Results 1 to 2 of 2

Thread: [VB6] ListBox Functions

  1. #1
    Saiyan Race
    j03's Avatar
    Joined
    Dec 2011
    Posts
    13,722
    Userbars
    166
    Thanks
    5,906
    Thanked
    33,078/6,609
    DL/UL
    23/36
    Mentioned
    3,867 times
    Time Online
    563d 5h 25m
    Avg. Time Online
    3h 13m

    [VB6] ListBox Functions

    None of these are mine. I was going through some old source files I have that someone else made (not for any of my applications) and found this module of listbox functions I think might be useful to someone. If anyone wants something converted to another language, let me know.

    Code:
    Option Explicit
    Public Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Public Declare Function SendMessageByString Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
    Public Declare Function SendMessageLong& Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
    Public Declare Function SendMessageByNum& Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
    Public Const LB_ADDSTRING& = &H180
    Public Const LB_DELETESTRING = &H182
    Public Const LB_FINDSTRINGEXACT& = &H1A2
    Public Const LB_GETCOUNT& = &H18B
    Public Const LB_GETCURSEL& = &H188
    Public Const LB_GETITEMDATA = &H199
    Public Const LB_GETTEXT = &H189
    Public Const LB_GETTEXTLEN& = &H18A
    Public Const LB_INSERTSTRING = &H181
    Public Const LB_RESETCONTENT& = &H184
    Public Const LB_SETHORIZONTALEXTENT = &H194
    Public Const LB_SETSEL = &H185
    '-----------------------------------------------
    Public Sub UCASEList(TheListBox As LISTBOX)
    Dim TempNumber As String
    TempNumber = 0
    While TempNumber < TheListBox.ListCount
    TheListBox.List(TempNumber) = UCase(TheListBox.List(TempNumber))
    TempNumber = Val(TempNumber) + Val(1)
    Wend
    
    End Sub
    Public Sub LCASEList(TheListBox As LISTBOX)
    Dim TempNumber As String
    TempNumber = 0
    While TempNumber < TheListBox.ListCount
    TheListBox.List(TempNumber) = LCase(TheListBox.List(TempNumber))
    TempNumber = Val(TempNumber) + Val(1)
    Wend
    
    End Sub
    Public Sub ReplaceInList(TheListBox As LISTBOX, WhatToReplace As String, ReplaceWith As String)
    Dim TempNumber As String
    TempNumber = 0
    While TempNumber < TheListBox.ListCount
    TheListBox.List(TempNumber) = Replace(TheListBox.List(TempNumber), WhatToReplace, ReplaceWith)
    TempNumber = Val(TempNumber) + Val(1)
    Wend
    
    End Sub
    Public Sub ConfirmClear(LISTBOX As LISTBOX)
    If MsgBox("Are you sure you want to clear this list?", vbYesNo, "Confirmation") = vbYes Then
    LISTBOX.Clear
    End If
    End Sub
    Public Sub xListKillDupes(LISTBOX As LISTBOX)
    'Kills dublicite items in a listbox
            Dim Search1 As Long
            Dim Search2 As Long
            Dim KillDupe As Long
    KillDupe = 0
    For Search1& = 0 To LISTBOX.ListCount - 1
    For Search2& = Search1& + 1 To LISTBOX.ListCount - 1
    KillDupe = KillDupe + 1
    If LISTBOX.List(Search1&) = LISTBOX.List(Search2&) Then
    LISTBOX.RemoveItem Search2&
    Search2& = Search2& - 1
    End If
    Next Search2&
    Next Search1&
    End Sub
    
    Public Function xListToTextString(LISTBOX As LISTBOX, InsertSeparator As String) As String
    'Makes list a txt string
    
            Dim CurrentCount As Long, PrepString As String
    For CurrentCount& = 0 To LISTBOX.ListCount - 1
    PrepString$ = PrepString$ & LISTBOX.List(CurrentCount&) & InsertSeparator$
    Next CurrentCount&
    xListToTextString$ = Left(PrepString$, Len(PrepString$) - 2)
    End Function
    Public Sub xListCopy(SourceList As Long, DestinationList As Long)
    'Copys a list to another
    'Call ListCopy ("list1", "List2")
            Dim SourceCount As Long, OfCountForIndex As Long, FixedString As String
    SourceCount& = SendMessageLong(SourceList&, LB_GETCOUNT, 0&, 0&)
    Call SendMessageLong(DestinationList&, LB_RESETCONTENT, 0&, 0&)
    If SourceCount& = 0& Then Exit Sub
    For OfCountForIndex& = 0 To SourceCount& - 1
    FixedString$ = String(250, 0)
    Call SendMessageByString(SourceList&, LB_GETTEXT, OfCountForIndex&, FixedString$)
    Call SendMessageByString(DestinationList&, LB_ADDSTRING, 0&, FixedString$)
    Next OfCountForIndex&
    End Sub
    
    Public Function xListGetText(LISTBOX As Long, Index As Long) As String
            Dim ListText As String * 256
    Call SendMessageByString(LISTBOX&, LB_GETTEXT, Index&, ListText$)
    xListGetText$ = ListText$
    End Function
    
    Public Sub xListRemoveSelected(LISTBOX As LISTBOX)
            Dim ListCount As Long
    ListCount& = LISTBOX.ListCount
    Do While ListCount& > 0&
    ListCount& = ListCount& - 1
    If LISTBOX.Selected(ListCount&) = True Then
    LISTBOX.RemoveItem (ListCount&)
    End If
    Loop
    End Sub
    Public Sub xLoad2listboxes(Path As String, List1 As LISTBOX, List2 As LISTBOX)
    'Loads Two list boxes
            Dim MyString As String, String1 As String, String2 As String
    On Error Resume Next
    Open Path$ For Input As #1
    While Not EOF(1)
    Input #1, MyString$
    String1$ = Left(MyString$, InStr(MyString$, "*") - 1)
    String2$ = Right(MyString$, Len(MyString$) - InStr(MyString$, "*"))
    DoEvents
    List1.AddItem String1$
    List2.AddItem String2$
    Wend
    Close #1
    End Sub
    Public Function xListClickEvent()
    'Have you ever wanted, on a listbox, that when a certain item is click, something
    'happens, well, this is the coding for it
    'Do not use this as in a module, but in the form, im just showing how its done.
    
    'Private Sub List1_Click()
    'If List1.List(List1.ListIndex) = "Source" Then
    'MsgBox "You Click Source in List1"
    'End If
    'End Sub
    
    End Function
    
    Public Sub xSaveList(filename As String, List As LISTBOX)
        'self explanatory
        On Error Resume Next
        Dim lngSave As Long
        
        If filename$ = "" Then Exit Sub
        
        Open filename$ For Output As #1
            For lngSave& = 0 To List.ListCount - 1
                Print #1, List.List(lngSave&)
            Next lngSave&
        Close #1
    End Sub
    Public Sub xLoadList(filename As String, List As LISTBOX)
        'self explanatory
        Dim lstInput As String
        On Error Resume Next
        Open filename$ For Input As #1
        While Not EOF(1)
            Input #1, lstInput$
            'DoEvents
            List.AddItem ReplaceText(lstInput$, "aol.com", "")
        Wend
        Close #1
    End Sub
    Public Function ReplaceText(tMain As String, tFind As String, tReplace As String) As String
        'replaces a string within a larger string
        Dim iFind As Long, lString As String, rString As String, rText As String, tMain2 As String
        
        iFind& = InStr(1, LCase(tMain$), LCase(tFind$))
        If iFind& = 0& Then ReplaceText = tMain$: Exit Function
        
        Do
            DoEvents
            
            lString$ = Left(tMain$, iFind& - 1)
            rString$ = Mid(tMain$, iFind& + Len(tFind$), Len(tMain$) - (Len(lString$) + Len(tFind$)))
            tMain$ = lString$ + "" + tReplace$ + "" + rString$
            
            iFind& = InStr(iFind& + Len(tReplace$), LCase(tMain$), LCase(tFind$))
            If iFind& = 0& Then Exit Do
        Loop
        
        ReplaceText = tMain$
    End Function
    Public Sub SaveListBox(Directory As String, TheList As LISTBOX)
        
        Dim savelist As Long
        On Error Resume Next
        Open Directory$ For Output As #1
        For savelist& = 0 To TheList.ListCount - 1
            Print #1, TheList.List(savelist&)
        Next savelist&
        Close #1
    End Sub
    Public Sub Loadlistbox(Directory As String, TheList As LISTBOX)
       
        Dim MyString As String
        On Error Resume Next
        Open Directory$ For Input As #1
        While Not EOF(1)
            Input #1, MyString$
            DoEvents
            TheList.AddItem MyString$
        Wend
        Close #1
    End Sub
    Public Sub Load2Lists(ListSN As LISTBOX, ListPW As LISTBOX, Target As String)
        'self explanatory
        On Error Resume Next
        
        Dim lstInput As String, strSN As String, strPW As String
        
        If FileExists(Target$) = True Then
            Open Target$ For Input As #1
                While Not EOF(1) = True
                    'DoEvents
                    Input #1, lstInput$
                    If InStr(1, lstInput$, "]-[") <> 0& And InStr(1, lstInput$, "=") <> 0& Then
                        lstInput$ = Mid(lstInput$, InStr(1, lstInput$, "]-[") + 3, Len(lstInput$) - 6)
                        strSN$ = Left(lstInput$, InStr(1, lstInput$, "=") - 1)
                        strPW$ = Right(lstInput$, Len(lstInput$) - InStr(1, lstInput$, "="))
                        If Trim(strSN$) <> "" And Trim(strPW$) <> "" Then
                            ListSN.AddItem Trim(strSN$)
                            ListPW.AddItem Trim(strPW$)
                        End If
                    ElseIf InStr(1, lstInput$, ":") <> 0& Then
                        strSN$ = Left(lstInput$, InStr(1, lstInput$, ":") - 1)
                        strPW$ = Right(lstInput$, Len(lstInput$) - InStr(1, lstInput$, ":"))
                        If Trim(strSN$) <> "" And Trim(strPW$) <> "" Then
                            ListSN.AddItem Trim(strSN$)
                            ListPW.AddItem Trim(strPW$)
                        End If
                    ElseIf InStr(1, lstInput$, "-") Then
                        strSN$ = Left(lstInput$, InStr(1, lstInput$, "-") - 1)
                        strPW$ = Right(lstInput$, Len(lstInput$) - InStr(1, lstInput$, "-"))
                        If Trim(strSN$) <> "" And Trim(strPW$) <> "" Then
                            ListSN.AddItem Trim(strSN$)
                            ListPW.AddItem Trim(strPW$)
                        End If
                    ElseIf InStr(1, lstInput$, "=") Then
                        strSN$ = Left(lstInput$, InStr(1, lstInput$, "=") - 1)
                        strPW$ = Right(lstInput$, Len(lstInput$) - InStr(1, lstInput$, "="))
                        If Trim(strSN$) <> "" And Trim(strPW$) <> "" Then
                            ListSN.AddItem Trim(strSN$)
                            ListPW.AddItem Trim(strPW$)
                        End If
                    ElseIf InStr(1, lstInput$, "�") Then
                        strSN$ = Left(lstInput$, InStr(1, lstInput$, "�") - 1)
                        strPW$ = Right(lstInput$, Len(lstInput$) - InStr(1, lstInput$, "�"))
                        If Trim(strSN$) <> "" And Trim(strPW$) <> "" Then
                            ListSN.AddItem Trim(strSN$)
                            ListPW.AddItem Trim(strPW$)
                        End If
                    End If
                Wend
            Close #1
        End If
    End Sub
    Public Sub Save2Lists(ListSN As LISTBOX, ListPW As LISTBOX, Target As String)
        'self explanatory
        Dim sLong As Long
        On Error Resume Next
        
        Open Target$ For Output As #1
            For sLong& = 0 To ListSN.ListCount - 1
                Print #1, "" + ListSN.List(sLong&) + ":" + ListPW.List(sLong&) + ""
            Next sLong&
        Close #1
    End Sub
    Public Function FileExists(TheFileName As String) As Boolean
    'Sees if the string(file) you specified exists
    If Len(TheFileName$) = 0 Then
    FileExists = False
    Exit Function
    End If
    If Len(Dir$(TheFileName$)) Then
    FileExists = True
    Else
    FileExists = False
    End If
    End Function
    Public Function ListBoxCheckDup(List As LISTBOX, Query As String) As Boolean
    'knot n chichris
        If Query = "" Then Exit Function
        If Not TypeOf List Is LISTBOX Then Exit Function
        Dim x As Long
        
        x = SendMessageByString(List.hWnd, LB_FINDSTRINGEXACT, 0&, Query)
        ListBoxCheckDup = IIf(x > -1, True, False)
    End Function
    Public Sub ClearListBoxes(frmTarget As Form)
        Dim I, j, ctrltarget
    
    
        For I = 0 To (frmTarget.Controls.Count - 1)
            Set ctrltarget = frmTarget.Controls(I)
    
    
            If TypeOf ctrltarget Is LISTBOX Then
                ctrltarget.Clear
            End If
        Next I
    End Sub
    
    
    Public Sub AddHScroll(List As LISTBOX)
        Dim I As Integer, intGreatestLen As Integer, lngGreatestWidth As Long
        'Find Longest Text in Listbox
    
    
        For I = 0 To List.ListCount - 1
    
    
            If Len(List.List(I)) > Len(List.List(intGreatestLen)) Then
                intGreatestLen = I
            End If
        Next I
        'Get Twips
        lngGreatestWidth = List.Parent.TextWidth(List.List(intGreatestLen) + Space(1))
        'Space(1) is used to prevent the last Ch
        '     aracter from being cut off
        'Convert to Pixels
        lngGreatestWidth = lngGreatestWidth \ Screen.TwipsPerPixelX
        'Use api to add scrollbar
        SendMessage List.hWnd, LB_SETHORIZONTALEXTENT, lngGreatestWidth, 0
        
    End Sub
    Sub SaveFormState(ByVal SourceForm As Form)
     Dim a As Long ' general purpose
     Dim B As Long
     Dim C As Long
     Dim filename As String ' where to save to
     Dim FHandle As Long ' FileHandle
     ' error handling code
     On Error GoTo fError
     ' we create a filename based on the formname
     filename = App.Path + "\" + SourceForm.Name + ".set"
     ' Get a filehandle
     FHandle = FreeFile()
     ' open the file
     #If DebugMode = 1 Then
      Debug.Print "--------------------------------------------------------->"
      Debug.Print "Saving Form State:" + SourceForm.Name
      Debug.Print "FileName=" + filename
     #End If
     Open filename For Output As FHandle
     ' loop through all controls
     ' first we save the type then the name
     For a = 0 To SourceForm.Controls.Count - 1
      #If DebugMode = 1 Then
       Debug.Print "Saving control:" + SourceForm.Controls(a).Name
      #End If
      ' if its textbox we save the .text property
      If TypeOf SourceForm.Controls(a) Is TextBox Then
       Print #FHandle, "TextBox"
       Print #FHandle, SourceForm.Controls(a).Name
       Print #FHandle, "StartText"
       Print #FHandle, SourceForm.Controls(a).Text
       Print #FHandle, "EndText"
        ' print a separator
       Print #FHandle, "|<->|"
      End If
      ' if its a checkbox we save the .value property
      If TypeOf SourceForm.Controls(a) Is CheckBox Then
       Print #FHandle, "CheckBox"
       Print #FHandle, SourceForm.Controls(a).Name
       Print #FHandle, Str(SourceForm.Controls(a).Value)
        ' print a separator
       Print #FHandle, "|<->|"
      End If
      ' if its a option button we save its value
      If TypeOf SourceForm.Controls(a) Is OptionButton Then
       Print #FHandle, "OptionButton"
       Print #FHandle, SourceForm.Controls(a).Name
       Print #FHandle, Str(SourceForm.Controls(a).Value)
        ' print a separator
       Print #FHandle, "|<->|"
      End If
      ' if its a listbox we save the .text and list contents
      If TypeOf SourceForm.Controls(a) Is LISTBOX Then
       Print #FHandle, "ListBox"
       Print #FHandle, SourceForm.Controls(a).Name
       Print #FHandle, SourceForm.Controls(a).Text
       Print #FHandle, "StartList"
       For B = 0 To SourceForm.Controls(a).ListCount - 1
        Print #FHandle, SourceForm.Controls(a).List(B)
       Next B
       Print #FHandle, "EndList"
       ' save listindex
       Print #FHandle, CStr(SourceForm.Controls(a).ListIndex)
        ' print a separator
       Print #FHandle, "|<->|"
      End If
      ' if its a combobox, save .text and list items
      If TypeOf SourceForm.Controls(a) Is ComboBox Then
       Print #FHandle, "ComboBox"
       Print #FHandle, SourceForm.Controls(a).Name
       Print #FHandle, SourceForm.Controls(a).Text
       Print #FHandle, "StartList"
       For B = 0 To SourceForm.Controls(a).ListCount - 1
        Print #FHandle, SourceForm.Controls(a).List(B)
       Next B
       Print #FHandle, "EndList"
        ' print a separator
       Print #FHandle, "|<->|"
      End If
     Next a
    ' close file
     #If DebugMode = 1 Then
      Debug.Print "Closing File."
      Debug.Print "<----------------------------------------------------------"
     #End If
     Close #FHandle
     ' stop error handler
     On Error GoTo 0
     Exit Sub
    fError: ' Simple error handler
     C = MsgBox("Error in SaveFormState. " + Err.Description + ", Number=" + CStr(Err.Number), vbAbortRetryIgnore)
     If C = vbIgnore Then Resume Next
     If C = vbRetry Then Resume
     ' else abort
    End Sub
    '===========================================================================
    ' LoadFormState:
    '  Loads the state of controls from file
    '
    '  Currently Supports: TextBox, CheckBox, OptionButton, Listbox, ComboBox
    '=============================================================================
    Sub LoadFormState(ByVal SourceForm As Form)
     Dim a As Long ' general purpose
     Dim B As Long
     Dim C As Long
     
     Dim txt As String ' general purpose
     Dim fData As String ' used to hold File Data
    ' these are variables used for controls data
     Dim cType As String ' Type of control
     Dim Cname As String ' Name of control
     Dim cNum As Integer ' number of control
    ' vars for the file
     Dim filename As String ' where to save to
     Dim FHandle As Long ' FileHandle
     ' error handling code
     'On Error GoTo fError
     ' we create a filename based on the formname
     filename = App.Path + "\" + SourceForm.Name + ".set"
     ' abort if file does not exist
     If Dir(filename) = "" Then
      #If DebugMode = 1 Then
       Debug.Print "File Not found:" + filename
      #End If
      Exit Sub
     End If
     ' Get a filehandle
     FHandle = FreeFile()
     ' open the file
     #If DebugMode = 1 Then
      Debug.Print "------------------------------------------------------>"
      Debug.Print "Loading FormState:" + SourceForm.Name
      Debug.Print "FileName:" + filename
     #End If
     Open filename For Input As FHandle
    ' go through file
     While Not EOF(FHandle)
      Line Input #FHandle, cType
      Line Input #FHandle, Cname
      ' Get control number
      cNum = -1
      For a = 0 To SourceForm.Controls.Count - 1
       If SourceForm.Controls(a).Name = Cname Then cNum = a
      Next a
      ' add some debug info if in debugmode
      #If DebugMode = 1 Then
       Debug.Print "Control Type=" + cType
       Debug.Print "Control Name=" + Cname
       Debug.Print "Control Number=" + CStr(cNum)
      #End If
      ' if we find control
      If Not cNum = -1 Then
       ' Depending on type of control, what data we get
       Select Case cType
       Case "TextBox"
        Line Input #FHandle, fData
        fData = "": txt = ""
        While Not fData = "EndText"
         If Not txt = "" Then txt = txt + vbCrLf
         txt = txt + fData
         Line Input #FHandle, fData
        Wend
        ' update control
        SourceForm.Controls(cNum).Text = txt
       Case "CheckBox"
        ' we get the value
        Line Input #FHandle, fData
        ' update control
        SourceForm.Controls(cNum).Value = fData
       Case "OptionButton"
        ' we get the value
        Line Input #FHandle, fData
        ' update control
        SourceForm.Controls(cNum).Value = fData
       Case "ListBox"
        ' clear listbox
        SourceForm.Controls(cNum).Clear
        ' get .text property
        Line Input #FHandle, fData
        SourceForm.Controls(cNum).Text = fData
        ' read past /startlist
        Line Input #FHandle, fData
        fData = "": txt = ""
        ' Get List
        While Not fData = "EndList"
         If Not fData = "" Then SourceForm.Controls(cNum).AddItem fData
         Line Input #FHandle, fData
        Wend
        ' get listindex
         Line Input #FHandle, fData
         SourceForm.Controls(cNum).ListIndex = Val(fData)
       Case "ComboBox"
        ' Clear combobox
        SourceForm.Controls(cNum).Clear
        ' Get Text
        Line Input #FHandle, fData
        SourceForm.Controls(cNum).Text = fData
        ' readpast /startlist
        Line Input #FHandle, fData
        fData = "": txt = ""
        ' get list
        While Not fData = "EndList"
         If Not fData = "" Then SourceForm.Controls(cNum).AddItem fData
         Line Input #FHandle, fData
        Wend
       End Select ' what type of control
      End If ' if we found control
      ' read till seperator
      fData = ""
      While Not fData = "|<->|"
       Line Input #FHandle, fData
      Wend
     Wend ' not end of File (EOF)
    ' close file
     #If DebugMode = 1 Then
      Debug.Print "Closing file.."
      Debug.Print "<------------------------------------------------------"
     #End If
     Close #FHandle
     Exit Sub
    fError: ' Simple error handler
     C = MsgBox("Error in LoadFormState. " + Err.Description + ", Number=" + CStr(Err.Number), vbAbortRetryIgnore)
     If C = vbIgnore Then Resume Next
     If C = vbRetry Then Resume
     ' else abort
    End Sub
    Sub add1(LISTBOX As LISTBOX)
    LISTBOX.AddItem "test"
    LISTBOX.AddItem "test2"
    LISTBOX.AddItem "test3"
    LISTBOX.AddItem "test4"
    LISTBOX.AddItem "test5"
    LISTBOX.AddItem "test6"
    End Sub
    Sub add2(LISTBOX As LISTBOX, txt As String)
    LISTBOX.AddItem txt$
    LISTBOX.AddItem txt$
    LISTBOX.AddItem txt$
    End Sub
    Public Sub FancyLoadList(Dialog As CommonDialog, List As LISTBOX)
        On Error GoTo e
        
        Dialog.DialogTitle = "Please Load A List"
        Dialog.CancelError = True
        Dialog.ShowOpen
        Loadlistbox Dialog.filename, List
    e:
    End Sub
    
    Public Sub FancySaveList(Dialog As CommonDialog, List As LISTBOX)
    Dialog.DialogTitle = "Please Save Your List."
    Dialog.ShowSave
    SaveListBox Dialog.filename, List
    End Sub
    This was originally not indented very well.
    (you need an account to see links)
    (you need an account to see links)(you need an account to see links)

    ------------------------
    [02/24/2013] Stealth CORE is made into the first standalone Neopets auto-player.
    ------------------------


  2. #2
    Zachafer's Avatar
    Joined
    Dec 2011
    Posts
    1,235
    Userbars
    11
    Thanks
    769
    Thanked
    1,466/678
    DL/UL
    98/0
    Mentioned
    512 times
    Time Online
    24d 13h 9m
    Avg. Time Online
    8m
    Ahh yes VB6

    Here's the listbox load/save functions I used to use. You don't need to add the CommonDialog Component to the project before using it
    Code:
    Option Explicit
    Dim cd As Object
    
    Public Sub SaveList(List As ListBox, Optional Title As String = "Save List", Optional clear As Boolean = False)
        On Error GoTo Handle:
        Set cd = CreateObject("MSComDlg.CommonDialog")
        cd.Filter = "Text Files (.txt)|*.txt"
        cd.filename = vbNullString
        cd.ShowSave
        cd.DialogTitle = Title
    
        If LenB(cd.filename) = 0 Then
            Exit Sub
        End If
        SaveFile List, cd.filename
        Exit Sub
    Handle:
        Debug.Print "Err #" & Err.Number & " on line " & Erl & vbNewLine & Err.Description
    End Sub
    
    Public Function LoadList(List As ListBox, Optional Title As String = "Load List", Optional clear As Boolean = True) As String
        On Error GoTo Handle:
        Set cd = CreateObject("MSComDlg.CommonDialog")
        cd.Filter = "Text Files (.txt)|*.txt"
        cd.filename = vbNullString
        cd.DialogTitle = Title
        cd.ShowOpen
    
        If LenB(cd.filename) = 0 Then
            Exit Function
        End If
    
        LoadFile List, cd.filename, clear
        LoadListCD = cd.filename
        Exit Function
    Handle:
        Debug.Print "Err #" & Err.Number & " on line " & Erl & vbNewLine & Err.Description
    End Function
    
    Public Sub LoadFile(List As ListBox, Path As String, Optional clear As Boolean = True)
        On Error GoTo eh:
        If clear Then
            List.clear
        End If
        Dim lx As String
        Open Path For Input As #1
        Do Until EOF(1)
            Line Input #1, lx
            List.AddItem lx
        Loop
        Close #1
        Exit Sub
    eh:
        Debug.Print "LoadFile Error: " & Err.Number & " " & Err.Description & " [" & Erl & "]"
    End Sub
    
    Public Sub SaveFile(List As ListBox, Path As String, Optional clear As Boolean = False)
        Dim x As Long
        If clear Then
            List.clear
        End If
        Open Path For Output As #1
        For x = 0 To List.ListCount - 1 Step 1
            Print #1, List.List(x)
        Next x
        Close #1
    End Sub
    (you need an account to see links)

  3. The Following User Says Thank You to Zachafer For This Useful Post:

    j03 (04-29-2015)

Tags for this Thread

Posting Permissions

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