Source code for Issue Number 91

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at info@codeoftheweek.com

Code of the Week Home


Source Code

Just paste this code into any module and change the name of the module to basInternetShortcut.

'----------------------------------------------------------------------
'
'   Class Name:     basInternetShortcut
'   Written By:     C&D Programming Corp.
'   Create Date:    3/99
'   Copyright:      Copyright 1999 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'
'
'----------------------------------------------------------------------
Option Explicit

'
'   If you do not want the option of automatically finding the Favorites
'   folder remove all references to the cRegistryUtils class.
'
Public Sub CreateInternetShortcut(sDescription As String, sURL As String, Optional sShortcutPath As String = "")
    Dim Reg As New cRegistryUtils
    Dim sFavorites As String
    Dim iFile As Integer

    On Error GoTo Handler

    ' Determine the location of the of the Favorites folder if the path is not
    ' specified.
    ' Take out the below section to remove the dependency on cRegistryUtils
    If sShortcutPath = "" Then
        sFavorites = Reg.ShellFolderPath("Favorites")
        ' make sure there is a backslash at the end.
        If Right(sFavorites, 1) <> "\" Then
            sFavorites = sFavorites & "\"
        End If
    Else
        sFavorites = sShortcutPath
    End If

'   Sample format of the Internet shortcut
'
'   [InternetShortcut]
'   URL=http://www.codeoftheweek.com

    iFile = FreeFile
    Open sFavorites & sDescription & ".url" For Output As iFile
    Print #iFile, "[InternetShortcut]"
    Print #iFile, "URL=" & sURL
    Close iFile
    Exit Sub

Handler:
    Err.Raise Err.Number, "CreateInternetShortcut", Err.Description
End Sub