Solved

Following a plain text Hyperlink from Access 2000

Posted on 2001-08-16
4
360 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
[X]
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
  • 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

Enterprise Mobility and BYOD For Dummies

Like “For Dummies” books, you can read this in whatever order you choose and learn about mobility and BYOD; and how to put a competitive mobile infrastructure in place. Developed for SMBs and large enterprises alike, you will find helpful use cases, planning, and implementation.

Question has a verified solution.

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

This article describes a method of delivering Word templates for use in merging Access data to Word documents, that requires no computer knowledge on the part of the recipient -- the templates are saved in table fields, and are extracted and install…
Traditionally, the method to display pictures in Access forms and reports is to first download them from URLs to a folder, record the path in a table and then let the form or report pull the pictures from that folder. But why not let Windows retr…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…
Visualize your data even better in Access queries. Given a date and a value, this lesson shows how to compare that value with the previous value, calculate the difference, and display a circle if the value is the same, an up triangle if it increased…

623 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