Make your own free website on Tripod.com
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