02/03/2013, 03:06
Enum BrowserName
'This Enum is part of Sub OpenURL()
InternetExplorer = 1
FireFox = 2
Chrome = 3
Opera = 4
End Enum
'---------------------------------------------------------------------------------------
' Procedure : OpenURL
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Open a URL in FireFox
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sURL : URL to open in FifeFox
'
' Usage:
' ~~~~~~
' Call OpenURL("http://www.google.ca", InternetExplorer)
' Call OpenURL("devhut.net", Chrome)
' Call OpenURL("msdn.com", FireFox)
' Call OpenURL("google.ca",Opera)
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2014-11-13 Initial Release
' 2 2018-02-01 Updated Copyright under CC licensing
' Error trapped FireFox not installed
' 3 2018-02-01 Complete revamp of the code to accomodate multiple
' Browser
'---------------------------------------------------------------------------------------
Sub OpenURL(ByVal sURL As String, ByVal lBrowser As BrowserName)
On Error GoTo Error_Handler
Dim WSHShell As Object
Dim sFFExe As String 'Executable path/filename
Dim sProgName As String 'Name of the Executable program
Dim sExe As String 'Excutable exe filename
Dim sCmdLineSwitch As String 'Command line switch
Dim sShellCmd As String 'Shell Command
'Determine the Path to FF executable
Select Case lBrowser
Case 1
'https://msdn.microsoft.com/en-us/library/hh826025(v=vs.85).aspx
sProgName = "Internet Explorer"
sExe = "IEXPLORE.EXE"
sCmdLineSwitch = " "
Case 2
'https://developer.mozilla.org/en-US/docs/Mozilla/Command_Line_Options#Browser
sProgName = "Mozilla Firefox"
sExe = "Firefox.EXE"
sCmdLineSwitch = " -new-tab "
Case 3
sProgName = "Google Chrome"
sExe = "Chrome.exe"
sCmdLineSwitch = " -tab "
Case 4
'http://www.opera.com/docs/switches/
sProgName = "Opera"
sExe = "opera.exe"
sCmdLineSwitch = " "
End Select
Set WSHShell = CreateObject("WScript.Shell")
sFFExe = WSHShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\" & _
"CurrentVersion\App Paths\" & sExe & "\")
sFFExe = Replace(sFFExe, Chr(34), "") 'Special case for Opera?!
'Open the URL
sShellCmd = """" & sFFExe & """" & "" & sCmdLineSwitch & """" & sURL & """"
Shell sShellCmd, vbHide
Error_Handler_Exit:
On Error Resume Next
If Not WSHShell Is Nothing Then Set WSHShell = Nothing
Exit Sub
Error_Handler:
If Err.Number = -2147024894 Then
MsgBox sProgName & " does not appear to be installed on this compter", _
vbInformation Or vbOKOnly, "Unable to open the requested URL"
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: OpenURL" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
End If
Resume Error_Handler_Exit
End Sub