VBA Internet Explorer will not follow hyperlink





    I am using Internet Explorer 6 and Access 2003 VBA.


    IE is starting up OK but when the program asks IE to go to another web site the IE session "flashes"

    as if the hyperlink is being followed but the display does not change. Also the code routine returns true in that it can

    find the hyperlink text.

    This hyperlink is  like  "/website2/". The first website is like https:///website1.

    The relevant html of website1 is:

    <a class='navbarIndentedLink' onmouseover='window.status="";return true' href='/website2/>Scripts</a>


    The strange thing is that the code seems to work OK with other websites.

    If I change the code so it goes to and ask it to follow the hyperlink for "maps" it works correctly.


    So it seems that VBA cannot process the link.

    The link works correctly when done manually.


    Can someone see how I can fix the problem?


    Code is attached.




    ' IE routines


    Option Compare Database

    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal Msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Const optActiveX As Boolean = False ' true for activex disabled Const brsVisible As Boolean = True ' true for debugging/voyeurism
    Dim brs As InternetExplorer

    Sub LoadPage()
      ' Pauses execution until the browser window has finished loading
      Do While brs.Busy Or brs.ReadyState <> READYSTATE_COMPLETE
        Sleep 100
        If optActiveX Then ' close any activex popup notifications
          PostMessage FindWindow("#32770", "Microsoft Internet Explorer"), &H10, 0&, 0&
        End If
    End Sub

    Public Function Hyperlink(Optional Text As String, Optional URL As String, Optional DisableOnClick As Boolean) As Boolean
    ' Clicks a link based on whichever of lnkText or lnkURL is provided, returning false if lnk cannot be found
    ' Optional lnkOnClick can be used to disable the OnClick event for the link
    Dim Element As HTMLLinkElement

      Hyperlink = False
      If Not URL = "" Then ' hyperlink by url
        URL = Replace(URL, "&", "&")
        For Each Element In brs.Document.links
          If Element = URL Then
            Hyperlink = True
            Exit For
          End If
        Next Element
      Else ' hyperlink by link text
        For Each Element In brs.Document.links
          If Element.innerText = Text Then
            Hyperlink = True
            Exit For
          End If
        Next Element
      End If
      If Hyperlink Then
        If DisableOnClick Then
          Element.OnClick = ""
        End If
       Call Element.Click
       Call LoadPage
      End If
    End Function


    '   Access form runs the routine below


    Private Sub btnIE_Click()
    Dim sURL As String
    Dim status As Boolean

      ' Start Internet Explorer
      Set brs = New InternetExplorer
      brs.Visible = brsVisible
      ' Go to starting page
      sURL = "https://website1/"

      brs.Navigate sURL
      Call LoadPage
      ' Go to the Scripts page
      status = Hyperlink("Scripts")
      If Not status Then
        MsgBox "Could not find Scripts hyperlink"
        Exit Sub
      End If
    End Sub

    Wednesday, June 04, 2008 6:43 AM