Populating ListBox With IE Favorites

[arpan_de]

I want to import all the IE favorites & populate them in a ListBox but if an IE favorite already is marked as a favorite in my browser, that favorite should not be listed in the ListBox. When users click a menu item, the ListBox should be populated. This is how I tried it:

'all the APIs & Constants come here

Private Sub mnuIEFav_Click()
    Dim FavPath  As String
    Dim FP       As FILE_PARAMS

    FavPath = GetFolderPath(CSIDL_FAVORITES)
    If (Len(FavPath) > 0) Then
        With FP
            .sFileRoot = FavPath
            .sFileNameExt = "*.url"
            .bRecurse = True
        End With

        'get the files
        Call SearchForFiles(FP)
    End If
End Sub

Private Function SearchForFiles(FP As FILE_PARAMS) As Double
    Dim hFile As Long
    Dim sTmp  As String
    Dim sPath As String
    Dim sRoot As String
    Dim WFD   As WIN32_FIND_DATA
    
    sRoot = QualifyPath(FP.sFileRoot)
    sPath = sRoot & "*.*"
    
    'obtain handle to the first match
    hFile = FindFirstFile(sPath, WFD)
    
    'if valid
    If (hFile <> INVALID_HANDLE_VALUE) Then
        Call GetFileInformation(FP)
        Do
            'if the returned item is a folder
            If ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY)) Then
                If (FP.bRecurse) Then
                    If (sTmp <> "." And sTmp <> "..") Then
                        FP.sFileRoot = sRoot & sTmp
                        Call SearchForFiles(FP)
                    End If
                End If
            End If
            'continue looping until FindNextFile returns 0 (no more matches)
        Loop While FindNextFile(hFile, WFD)

        'close the find handle
        hFile = FindClose(hFile)
    End If
End Function

Private Function GetFileInformation(FP As FILE_PARAMS) As Long
    Dim pos       As Long
    Dim hFile     As Long
    Dim sTmp      As String
    Dim sUrl      As String
    Dim sPath     As String
    Dim sRoot     As String
    Dim FileName  As String
    Dim sShortcut As String
    Dim blnFavURL As Boolean
    Dim iFile     As Integer
    Dim i         As Integer
    Dim WFD       As WIN32_FIND_DATA
    
    sRoot = QualifyPath(FP.sFileRoot)
    sPath = sRoot & FP.sFileNameExt
    i = 0
    
    hFile = FindFirstFile(sPath, WFD)
    If (hFile <> INVALID_HANDLE_VALUE) Then
        Do
            If Not ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) Then
                pos = InStr(sTmp, ".url")
                If (pos > 0) Then
                    sShortcut = Left$(sTmp, pos - 1)
                    sUrl = ProfileGetItem("InternetShortcut", "URL", "", sRoot & sTmp)
                    blnFavURL = IfExistsURL(Trim(sUrl))
                    If (blnFavURL = False) Then
                        List1.AddItem sShortcut
                    Else
                        MsgBox sUrl & vbNewLine & "The above URL already exists!"
                    End If
                End If
            End If
        Loop While FindNextFile(hFile, WFD)

        'close the handle
        hFile = FindClose(hFile)
    End If
End Function

Function IfExistsURL(URL As String) As Boolean
    Dim FavURLs As String
    Dim i       As Integer
    
    For i = 0 To mnuFavSites.UBound
        FavURLs = mnuFavSites(i).Tag
        If (LCase(URL) = LCase(FavURLs)) Then
            IfExistsURL = True
            Exit Function
        End If
    Next i
End Function

Private Function QualifyPath(sPath As String) As String
    If (Right$(sPath, 1) <> "\") Then
        QualifyPath = sPath & "\"
    Else
        QualifyPath = sPath
    End If
End Function

The problem is when the menu item is clicked for the first time, the ListBox gets populated with all the IE favorites that don't exist in my browser's favorites but if the menu item is clicked again, the ListBox again gets populated with the IE favorites i.e. the ListBox lists duplicate items.

For e.g. when the menu item is clicked for the first time, assume that 10 favorites get populated in the ListBox. If the menu item is clicked again, the same favorites again get added in the ListBox & hence the no. of items in the ListBox doubles to 20 where as it should have only 10 items.

How do I ensure that duplicate favorites do not get added in the ListBox?

I know that the following code will ensure that there aren't any duplicates in a ListBox but I don't know why it isn't working:

For i = 0 To List1.ListCount - 1
    For j = 0 To List1.ListCount - 1
        If (List1.List(i) = List1.List(j)) Then
            List1.RemoveItem j
        End If
    Next
Next

[arpan_de]

Sorry mates to bother you but I have got the solution. I was missing the all very important comparison in the If condition (shown at the end of thread #1). It should have read:

If (List1.List(i) = List1.List(j) And j <> i) Then

[arpan_de]

Friends, the code I have cited in the above 2 threads first adds items to the ListBox, then checks if there are any duplicate items & then removes the duplicate items. Won't a better approach will be to first check whether the item that will be added in the ListBox is already listed in the ListBox & then add the item if it already doesn't exist in the ListBox? But how do I go about it?

[Zach_VB6]

What I would do:

Take your browser's current bookmarks and export them to an array...
Public Function ListToArray(ByVal List As ListBox, ByRef toArray() As String) As String()
Dim i As Long
'rcadble's
ReDim toArray(List.ListCount - 1) As String
For i = 0 To List.ListCount - 1
toArray(i) = List.List(i)
Next
ListToArray = toArray
End Function

Then use 2 integers and a for...next loop to check the items.

[Joacim Andersson]

Before you add the item to the listbox, send a LB_FINDSTRINGEXACT message to it to search the listbox after the string, if not found (SendMessage returns -1) then add it. The following snippet demonstrates this (I assume you know how to find SendMessage and the named constant using the API Viewer).

If SendMessage(List1.hWnd, LB_FINDSTRINGEXACT, -1, ByVal sShortCut) = -1 Then
    List1.AddItem sShortCut
End If

BTW, the way you searched the ListBox is a bit stupid (sorry for being blunt), but suppose the ListBox contains three items you then start by ignoring to check if the first item matches the first item. You then compare the first item with the second item followed by comparing the first with the third. You then start over and compare the second item with the first (which is already done once already). If you wanted a nested loop as the one you have it should look like this:

For x = (List1.ListCount - 2) To 0 Step -1
    For y = (List1.ListCount - 1) To (x + 1) Step -1
        If List1.List(x) = List1.List(y) Then
            List1.RemoveItem y
        End If
    Next
Next

[arpan_de]

Thanks, Joacim, for pointing out that my approach is stupid....it is indeed stupid.....not a bit stupid....rather too stupid since if the ListBox happens to list a lot of items (& it actually does...around 100 items), it would unnecessarily do a lot of extra work.

[Joacim Andersson]

Well, it is also a tiny bit stupid to first add the items and then loop through them to search for duplicates to remove... But you realised that yourself, the best approach is to send LB_FINDSTRINGEXACT to see if a string already exists before adding it as shown in my previous post.