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