Enum BrowserName
'This Enum is part of Sub OpenURL()
' *** If changes are made here, update GetBrowserNameEnumValue()
iexplore = 1
firefox = 2
chrome = 3
opera = 4
msedge = 5
brave = 6
End Enum
'---------------------------------------------------------------------------------------
' Procedure : OpenURL
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Open a URL in a browser
' 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
' Dependencies: BrowserName Enum, GetDefaultBrowser(), GetBrowserNameEnumValue()
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sURL : URL to open
' lBrowser : Optional, browser to be used to open the URL, if omitted, the system's
' default browser will be used
'
' Usage:
' ~~~~~~
' Call OpenURL("https://www.google.ca") 'will use the user's default browser
' Call OpenURL("https://www.google.ca", iexplore)
' Call OpenURL("devhut.net", chrome)
' Call OpenURL("msdn.com", firefox)
' Call OpenURL("google.ca", opera)
' Call OpenURL("https://www.google.ca", msedge)
' Call OpenURL("https://www.google.ca", brave)
'
' 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
' 4 2020-04-27 Added Microsoft Edge
' Added Brave
' 5 2020-12-14 Adapted to now have lBrowser as optional and the
' ability to determine the system's default browser
' 6 2022-07-03 Fixed usage examples to match Enum, forgot to do so
' after the last update
' changed msedge sExe to make people happy, not used!
'---------------------------------------------------------------------------------------
Sub OpenURL(ByVal sURL As String, Optional lBrowser As BrowserName)
Dim oShell As Object
Dim sFFExe As String 'Executable path/filename
Dim sProgName As String 'Name of the Executable program
Dim sExe As String 'Executable exe filename
Dim sCmdLineSwitch As String 'Command line switch
Dim sShellCmd As String 'Shell Command
On Error GoTo Error_Handler
'If no browser is specified then use the system's default one
If lBrowser = 0 Then
lBrowser = GetBrowserNameEnumValue(GetDefaultBrowser())
End If
'Determine the Path to 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 = " "
Case 5
sProgName = "Microsoft Edge"
sExe = "msedge.exe"
sCmdLineSwitch = " -tab "
Case 6
sProgName = "Brave"
sExe = "brave.exe"
sCmdLineSwitch = " -tab "
End Select
If lBrowser = 5 Then 'Special case for Edge! Thank you Microsoft for not following the rules!
'Build the command
sShellCmd = "cmd /c """ & "start microsoft-edge:" & sURL & """"
Else
Set oShell = CreateObject("WScript.Shell")
sFFExe = oShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\" & _
"CurrentVersion\App Paths\" & sExe & "\")
'Parse the returned string
sFFExe = Replace(sFFExe, Chr(34), "") 'Special case for Opera?!
'Build the command
sShellCmd = """" & sFFExe & """" & "" & sCmdLineSwitch & """" & sURL & """"
End If
'Open the URL
Shell sShellCmd, vbHide
Error_Handler_Exit:
On Error Resume Next
If Not oShell Is Nothing Then Set oShell = 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
'---------------------------------------------------------------------------------------
' Procedure : GetDefaultBrowser
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Returns the name of the System's Default Web Browser
' 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
'
' Usage:
' ~~~~~~
' GetDefaultBrowser()
' -> msedge, firefox, brave, iexplore, ...
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2020-12-14 Initial Release
'---------------------------------------------------------------------------------------
Function GetDefaultBrowser() As String
Dim oShell As Object
Dim sProgId As String
Dim sCommand As String
Dim aCommand As Variant
On Error GoTo Error_Handler
Set oShell = CreateObject("WScript.Shell")
'Default ProgId
sProgId = oShell.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\Shell\Associations" & _
"\UrlAssociations\https\UserChoice\ProgId")
'Cross-reference the sProgId to get the exe associated with it
sCommand = oShell.RegRead("HKEY_CLASSES_ROOT\" & sProgId & "\shell\open\command\")
'Parse the returned value to extract just the exe filename
aCommand = Split(sCommand, Chr(34))
GetDefaultBrowser = Right(aCommand(1), Len(aCommand(1)) - InStrRev(aCommand(1), "\")) ' firefox.exe
GetDefaultBrowser = Left(GetDefaultBrowser, InStr(GetDefaultBrowser, ".") - 1) 'firefox
Error_Handler_Exit:
On Error Resume Next
If Not oShell Is Nothing Then Set oShell = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: GetDefaultBrowser" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
'---------------------------------------------------------------------------------------
' Procedure : GetBrowserNameEnumValue
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Convert the returned value from GetDefaultBrowser() into the proper Enum
' Value. This is required as VBA offers no way to evaluate a returned
' value from a function against an Enum, no way to iterate over the string
' values of an Enum, ...
' 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: None required
'
' Usage:
' ~~~~~~
' GetBrowserNameEnumValue(GetDefaultBrowser())
' -> 1, 2, 3, ...
' GetBrowserNameEnumValue("firefox")
' -> 2
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2020-12-14 Initial Release
'---------------------------------------------------------------------------------------
Function GetBrowserNameEnumValue(sInput As String) As Long
On Error GoTo Error_Handler
Select Case sInput
Case "iexplore"
GetBrowserNameEnumValue = BrowserName.iexplore
Case "firefox"
GetBrowserNameEnumValue = BrowserName.firefox
Case "chrome"
GetBrowserNameEnumValue = BrowserName.chrome
Case "opera"
GetBrowserNameEnumValue = BrowserName.opera
Case "msedge"
GetBrowserNameEnumValue = BrowserName.msedge
Case "brave"
GetBrowserNameEnumValue = BrowserName.brave
Case Else
GetBrowserNameEnumValue = 0
End Select
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: GetBrowserNameEnumValue" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
