Adding to the Favourites
Fancy adding your Web site to the list of Favourites?
This sneaky commented code snippet shows you how.
To run, simply call AddFavorite, passing your site name and Web address. This code works by grabbing the location of the Favorite folder with the help of a couple of API calls. It then creates an Internet 'link' file in that location, using the passed site name and address.
Usage
AddFavorite "VB-World", "http://www.vbworld.com/"
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 Goodbye
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
Goodbye:
End Sub