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