Hello Oreg,
This macro module will allow to set the browser you want to use and
allow you to call up either a URL or email address. Insert a VBA Module
into your project and copy and paste the code into it.
TO SET YOUR BROWSER:
SetBrowserPath ("C:\Program
Files\Netscape\Communicator\Program\netscape.exe")
If you don't set the browser path, the system will use the default
browser. Once you have set the browser path, you won't need to set it
again, unless you decide to change browser. The setting is saved in the
registry.
GO TO A WEBSITE:
Using a String Variable...
URL = "
http://www.google.com/"
GoToWebsite (URL)
Direct Assignment...
GoToWebsite ("
http://www.google.com/")
MODULE CODE
Code:
--------------------
'////////////////////////////////////////////'
'/ /'
'/ This Module will connect to an Internet /'
'/ Website (URL) using the default browser /'
'/ or the browser of your choosing. /'
'/ /'
'/ This code works with Windows '95, '98, /'
'/ ME, 2000, and XP. /'
'/ /'
'/ /'
'/ Copyright Feb. 2001 /'
'/ Author: Leith Ross /'
'/ Company: Ross Associates /'
'/ /'
'/ This code may be used and distributed /'
'/ only with the inclusion of this notice. /'
'/ /'
'////////////////////////////////////////////'
'This will Launch the Browser and go to the URL
Private Declare Function ShellExecute _
Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hWnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
'This Call is Used to Find the Default Browser
Private Declare Function FindExecutable _
Lib "shell32.dll" _
Alias "FindExecutableA" _
(ByVal lpFile As String, _
ByVal lpDirectory As String, _
ByVal lpResult As String) As Long
'Returns the Handle of the Active Window
Private Declare Function GetActiveWindow _
Lib "User32.dll" () As Long
Private Function GetDefaultBrowser() As String
Dim FileName As String, Dummy As String
Dim RetVal As Long
Dim FileNumber As Integer
Dim DefaultBrowser As String * 260
' First, create a known, temporary HTML file
DefaultBrowser = Space(260)
FileName = "C:\Temphtm.htm"
FileNumber = FreeFile ' Get unused file number
Open FileName For Output As #FileNumber ' Create temp HTML file
Write #FileNumber, "<HTML> <\HTML>" ' Output text
Close #FileNumber
' Then find the application associated with it
RetVal = FindExecutable(FileName, Dummy, DefaultBrowser)
N = InStr(1, DefaultBrowser, vbNullChar)
DefaultBrowser = Left(DefaultBrowser, N)
Kill FileName
' Check If a Browser Exists
If RetVal <= 32 Or IsEmpty(DefaultBrowser) Then
MsgBox "Could not find associated Browser", vbExclamation, _
"Internet API"
GetDefaultBrowser = ""
End If
' Return the Fully Qualified Path to the Browser
GetDefaultBrowser = DefaultBrowser
End Function
Public Sub GoToWebSite(ByVal Site_Address As String)
Dim RetVal
Dim TaskID
Dim N As Long
Dim X As Long
Dim CurWin As Long
Dim NoData As String
Dim AppPath As String
Dim URL As String
Dim Msg As String
Dim Title As String
Dim Buttons As Integer
Buttons = vbOKOnly + vbCritical
Title = "Internet API"
CurWin = GetActiveWindow
NoData = vbNullString
URL = Site_Address
AppPath = GetSetting("URL Code", "Browser", "Path", "")
If AppPath = "" Then
AppPath = GetDefaultBrowser
End If
'Check for Address
N = InStr(1, URL, "://")
'Check for E-Mail
X = InStr(1, URL, "@")
'Default Protocol is Http
If N = 0 And X = 0 Then
URL = "http://" & URL
Else
'E-Mail Address
If N = 0 And X > 0 Then
URL = "mailto:" & Trim(URL)
End If
End If
TaskID = ShellExecute(CurWin, "Open", AppPath, URL, NoData, vbNormalFocus)
'Call Shell("rundll32.exe url.dll,FileProtocolHandler " & URL, vbNormalFocus)
' Did Connection Fail? Errors are from 0 to 32
If TaskID < 33 Then
Msg = "Unable to Connect to " & URL & vbCrLf _
& "Error Number " & Str(TaskID)
RetVal = MsgBox(Msg, Buttons, Title)
End If
End Sub
Public Sub SetBrowserPath(ByVal Browser_Path As String)
SaveSetting "URL Code", "Browser", "Path", Browser_Path
End Sub