Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people, just like you, are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
Solved

Following a plain text Hyperlink from Access 2000

Posted on 2001-08-16
4
346 Views
Last Modified: 2012-08-13
I have a form with two controls

btnFollowHyperlink

and a bound textbox
CompanyWebsite

When I click on btnFollowHyperlink I want to launch Internet Explorer and make it go to the website stored as plaintext in CompanyWebsite.

And no I do not want to use the native access hyperlink datatype :-)


The code I have is as follows.  It seems that this used to work on Windows98 and Access2000, but now doesnt work under Windows2000 Pro.  Any ideas?


Private Sub btnFollowHyperlink_Click()

    On Error GoTo bfhErr:

    Dim stDocName As String

    stDocName = Forms!Contacts!CompanyWebsite

    Dim ctl As CommandButton
    Set ctl = Me!btnFollowHyperlink
    With ctl
        Application.FollowHyperlink stDocName, , True
    End With


    DoCmd.Maximize

    Exit Sub

bfhErr:
    Select Case Err.Number
        Case 5:
            MsgBox "There is no internet connection", vbInformation, "Please connect to the internet and try again."
            Resume Next
        Case 6:
            MsgBox "The page could not be found online.  Please check the address.", vbInformation, "Page not found."
            Resume Next

        Case Else:
            MsgBox "Problem Number " & CStr(Err.Number) & " - " & Err.Description
            Exit Sub
    End Select

    Exit Sub




0
Comment
Question by:mmerlin
  • 2
4 Comments
 
LVL 1

Author Comment

by:mmerlin
ID: 6391855
the link might also be a mailto:mm@ecoms.com kind of link which should activate the default email client
0
 
LVL 12

Expert Comment

by:Paurths
ID: 6391994
hi mmerlin,

here is an example of starting internet explorer, or the default email editor, depending on   stDocName


Dim retvar
Dim IEPath As String
Dim stDocName As String

'this is your field from your table, placed in a variable
stDocName = "your@email.com"
stDocName = "www.experts-exchange.com"

If InStr(stDocName, "@") Then

    DoCmd.SendObject acSendNoObject, , acFormatRTF, stDocName, , , , , True
   
Else

    IEPath = fReturnRegKeyValue(HKEY_CLASSES_ROOT, "Applications\iexplore.exe\shell\open\command", "")
    IEPath = Left(IEPath, Len(IEPath) - 2)
    retvar = Shell(IEPath & " " & stDocName, vbMaximizedFocus)
   
End If
End Sub




u will need to paste this into a new module:


Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006

Private Const STANDARD_RIGHTS_READ = &H20000
Private Const KEY_QUERY_VALUE = &H1&
Private Const KEY_ENUMERATE_SUB_KEYS = &H8&
Private Const KEY_NOTIFY = &H10&
Private Const SYNCHRONIZE = &H100000
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
                        KEY_QUERY_VALUE Or _
                        KEY_ENUMERATE_SUB_KEYS Or _
                        KEY_NOTIFY) And _
                        (Not SYNCHRONIZE))
Private Const MAXLEN = 256
Private Const ERROR_SUCCESS = &H0&

Const REG_NONE = 0
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_DWORD_LITTLE_ENDIAN = 4
Const REG_DWORD_BIG_ENDIAN = 5
Const REG_LINK = 6
Const REG_MULTI_SZ = 7
Const REG_RESOURCE_LIST = 8

Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Declare Function apiRegOpenKeyEx Lib "advapi32.dll" _
        Alias "RegOpenKeyExA" (ByVal hKey As Long, _
        ByVal lpSubKey As String, ByVal ulOptions As Long, _
        ByVal samDesired As Long, ByRef phkResult As Long) _
        As Long

Private Declare Function apiRegCloseKey Lib "advapi32.dll" _
        Alias "RegCloseKey" (ByVal hKey As Long) As Long

Private Declare Function apiRegQueryValueEx Lib "advapi32.dll" _
        Alias "RegQueryValueExA" (ByVal hKey As Long, _
        ByVal lpValueName As String, ByVal lpReserved As Long, _
        ByRef lpType As Long, lpData As Any, _
        ByRef lpcbData As Long) As Long

Private Declare Function apiRegQueryInfoKey Lib "advapi32.dll" _
        Alias "RegQueryInfoKeyA" (ByVal hKey As Long, _
        ByVal lpClass As String, ByRef lpcbClass As Long, _
        ByVal lpReserved As Long, ByRef lpcSubKeys As Long, _
        ByRef lpcbMaxSubKeyLen As Long, _
        ByRef lpcbMaxClassLen As Long, _
        ByRef lpcValues As Long, _
        ByRef lpcbMaxValueNameLen As Long, _
        ByRef lpcbMaxValueLen As Long, _
        ByRef lpcbSecurityDescriptor As Long, _
        ByRef lpftLastWriteTime As FILETIME) As Long

Function fReturnRegKeyValue(ByVal lngKeyToGet As Long, _
                            ByVal strKeyName As String, _
                            ByVal strValueName As String) _
                            As String
Dim lnghKey As Long
Dim strClassName As String
Dim lngClassLen As Long
Dim lngReserved As Long
Dim lngSubKeys As Long
Dim lngMaxSubKeyLen As Long
Dim lngMaxClassLen As Long
Dim lngValues As Long
Dim lngMaxValueNameLen As Long
Dim lngMaxValueLen As Long
Dim lngSecurity As Long
Dim ftLastWrite As FILETIME
Dim lngType As Long
Dim lngData As Long
Dim lngTmp As Long
Dim strRet As String
Dim varRet As Variant
Dim lngRet As Long
   
    On Error GoTo fReturnRegKeyValue_Err
       
    'Open the key first
    lngTmp = apiRegOpenKeyEx(lngKeyToGet, _
                strKeyName, 0&, KEY_READ, lnghKey)

    'Are we ok?
    If Not (lngTmp = ERROR_SUCCESS) Then Err.Raise _
                                lngTmp + vbObjectError

    lngReserved = 0&
    strClassName = String$(MAXLEN, 0):  lngClassLen = MAXLEN

    'Get boundary values
    lngTmp = apiRegQueryInfoKey(lnghKey, strClassName, _
        lngClassLen, lngReserved, lngSubKeys, lngMaxSubKeyLen, _
        lngMaxClassLen, lngValues, lngMaxValueNameLen, _
        lngMaxValueLen, lngSecurity, ftLastWrite)

    'How we doin?
    If Not (lngTmp = ERROR_SUCCESS) Then Err.Raise _
                                lngTmp + vbObjectError
   
    'Now grab the value for the key
    strRet = String$(MAXLEN - 1, 0)
    lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
                lngReserved, lngType, ByVal strRet, lngData)
    Select Case lngType
      Case REG_SZ
        lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
                lngReserved, lngType, ByVal strRet, lngData)
        varRet = Left(strRet, lngData - 1)
      Case REG_DWORD
        lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
                lngReserved, lngType, lngRet, lngData)
        varRet = lngRet
      Case REG_BINARY
        lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
                lngReserved, lngType, ByVal strRet, lngData)
        varRet = Left(strRet, lngData)
    End Select
   
    'All quiet on the western front?
    If Not (lngTmp = ERROR_SUCCESS) Then Err.Raise _
                                lngTmp + vbObjectError

fReturnRegKeyValue_Exit:
    fReturnRegKeyValue = varRet
    lngTmp = apiRegCloseKey(lnghKey)
    Exit Function
fReturnRegKeyValue_Err:
    varRet = "Error: Key or Value Not Found."
    Resume fReturnRegKeyValue_Exit
End Function


hope this helps,
Ricky


0
 
LVL 12

Accepted Solution

by:
Paurths earned 299 total points
ID: 6392016
just to add,

the usual path of ie is c:\Program Files\internet explorer\iexplore.exe

tho i have never seen iexplore in another folder, it might just happen.
But u can try this code, so u dont need to read the registry:


Dim retvar
Dim stDocName As String

'this is your field from your table, placed in a variable
stDocName = "your@email.com"
stDocName = "www.experts-exchange.com"

If InStr(stDocName, "@") Then

   DoCmd.SendObject acSendNoObject, , acFormatRTF, stDocName, , , , , True
   
Else

   retvar = Shell("c:\Program Files\internet explorer\iexplore.exe " & stDocName, vbMaximizedFocus)
'mind, the space between <...iexplore.exe>   and  <" & stDo..> has to be there !
   
End If



cheers
Ricky
0
 
LVL 6

Expert Comment

by:devtha
ID: 6392646
MM

   Dim ctl As CommandButton
   Set ctl = Me!btnFollowHyperlink
   With ctl
       Application.FollowHyperlink Me!Text0, , True
   End With



the textbox here is text0 and this works
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When you are entering numbers in a speadsheet, and don't remember what 6×7 is, you just type “=6*7" instead. It works in every cell! This is not so in Access. To enter the elusive 42 in a text box, you have to find a calculator, and then copy the re…
Experts-Exchange is a great place to come for help with solutions for your database issues, and many problems are resolved within minutes of being posted.  Others take a little more time and effort and often providing a sample database is very helpf…
In Microsoft Access, learn how to “cascade” or have the displayed data of one combo control depend upon what’s entered in another. Base the dependent combo on a query for its row source: Add a reference to the first combo on the form as criteria i…
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …

840 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question