Add Bookmark To User Favorite Folder

This code will find the user Favorites folder, and will add your link to it.

Module Code

Private Declare Function SHGetSpecialFolderLocation _
   
Lib "shell32.dll" (ByVal hwndOwner As Long, _
  
ByVal nFolder As SpecialShellFolderIDs, _
   pidl
As Long) As Long
  
Private Declare Function SHGetPathFromIDList _
   
Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
    (
ByVal pidl As Long, _
   
ByVal pszPath As String) As Long

Private Declare Sub CoTaskMemFree Lib "ole32.dll" _
    (
ByVal pv As Long)

Public Enum SpecialShellFolderIDs
   CSIDL_DESKTOP = &H0
   CSIDL_INTERNET = &H1
   CSIDL_PROGRAMS = &H2
   CSIDL_CONTROLS = &H3
   CSIDL_PRINTERS = &H4
   CSIDL_PERSONAL = &H5
   CSIDL_FAVORITES = &H6
   CSIDL_STARTUP = &H7
   CSIDL_RECENT = &H8
   CSIDL_SENDTO = &H9
   CSIDL_BITBUCKET = &HA
   CSIDL_STARTMENU = &HB
   CSIDL_DESKTOPDIRECTORY = &H10
   CSIDL_DRIVES = &H11
   CSIDL_NETWORK = &H12
   CSIDL_NETHOOD = &H13
   CSIDL_FONTS = &H14
   CSIDL_TEMPLATES = &H15
   CSIDL_COMMON_STARTMENU = &H16
   CSIDL_COMMON_PROGRAMS = &H17
   CSIDL_COMMON_STARTUP = &H18
   CSIDL_COMMON_DESKTOPDIRECTORY = &H19
   CSIDL_APPDATA = &H1A
   CSIDL_PRINTHOOD = &H1B
   CSIDL_ALTSTARTUP = &H1D
   CSIDL_COMMON_ALTSTARTUP = &H1E
   CSIDL_COMMON_FAVORITES = &H1F
   CSIDL_INTERNET_CACHE = &H20
   CSIDL_COOKIES = &H21
   CSIDL_HISTORY = &H22
End Enum


Public Sub AddFavorite(SiteName As String, URL As String)

Dim pidl As Long
Dim intFile As Integer
Dim strFullPath As String

On Error GoTo ErrorHandler

intFile = FreeFile
strFullPath =
Space(255)

'Check the API for the folder existence and location

If SHGetSpecialFolderLocation(0, CSIDL_FAVORITES, pidl) = 0 Then

If pidl Then

If SHGetPathFromIDList(pidl, strFullPath) Then

' Trim any null characters

If
InStr(1, strFullPath, Chr(0)) Then
strFullPath = Mid(strFullPath, 1, _
InStr(1, strFullPath,
Chr(0)) - 1)
End
If

' Add back slash, if none exists

If
Right(strFullPath, 1) <> "\" Then
strFullPath = strFullPath & "\"
End
If

' Create the link

strFullPath = strFullPath & SiteName & ".URL"
Open strFullPath
For Output As #intFile
Print #intFile, "[InternetShortcut]"
> Print #intFile, "URL=" & URL
Close #intFile

End If

CoTaskMemFree pidl

End If

End If

ErrorHandler:
   
End
Sub

Form Code

Private Sub Form_Load()
    AddFavorite "VB-Town", "http://www.vb-town.com/"
End Sub


Go Back