NavigateTo(URL) mehtod

Posted on 1999-01-04
Medium Priority
Last Modified: 2008-01-09
I a writing an ActiveX control and using a Hyperlink object and the navigateTo method on an event to go to an HTML page.
The syntax is :

Dim s as Hyperlink

Any ideas??
Executing this code gives me a 'Runtime error 91
Object Variable or With blcok variable not set'

Note : This is not because of the NEW keyword missing!

Question by:alfaromeo
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
  • 2
LVL 14

Expert Comment

ID: 1453792
You could use :

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

ShellExecute 0&, vbNullString, "http://www.geocities.com/ResearchTriangle/6311/", vbNullString, vbNullString, vbNormalFocus


Author Comment

ID: 1453793
Actually,  I already have the browser running ( the control is within the browser container). When the user clicks on the a bttuon in the ActiveX Control I need to display a local HTML page.

So the seqence is :

 if option1.value then
 end if

LVL 14

Accepted Solution

waty earned 200 total points
ID: 1453794
Use the following code, I use it in my VBIDEUtils add-ins (http://www.geocities.com/ResearchTriangle/6311/) and works perfectly :

' *** To load a file
Call InitWebBrowser(sFilename, True)

' *** To Load an url
Call InitWebBrowser("http://www.geocities.com/ResearchTriangle/6311/", True)

'This sample will show you how to use the WebBrowser Control and
'how to disable right click context menu for browser's window.
'Requires installed Internet Explorer 3.xx or Internet Explorer 4.xx.
'Works with both versions.
'This sample works with All version of VB5.
'Author   : Serge Baranovsky
'Email    : baranovsky@altavista.net
'Internet : http://www.geocities.com/SiliconValley/Hills/9086/
'Date     : 16-07-98

Option Explicit

#Const bAllowRightClick = False

Public encount As Long
Public hwnds() As Long

Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) As Long
Private Declare Function GetFocus Lib "user32" () As Long

'GetWindow constants
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDLAST = 1
Private Const GW_HWNDNEXT = 2
Private Const GW_HWNDPREV = 3
Private Const GW_OWNER = 4
Private Const GW_CHILD = 5

' Window field offsets for GetWindowLong() and GetWindowWord()
Private Const GWL_WNDPROC = (-4)
Private Const GWL_HINSTANCE = (-6)
Private Const GWL_HWNDPARENT = (-8)
Private Const GWL_STYLE = (-16)
Private Const GWL_EXSTYLE = (-20)
Private Const GWL_USERDATA = (-21)
Private Const GWL_ID = (-12)

Private Const WS_VSCROLL = &H200000

Private Const WM_ACTIVATE = &H6
Private Const WM_ACTIVATEAPP = &H1C
Private Const WM_KILLFOCUS = &H8
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206

Private Const WM_PARENTNOTIFY = &H210

Public prevWndProc() As Long
Public prevWndProcCount As Integer

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

' ShellExecute Declarations ...
Private Const SW_SHOWDEFAULT = 10

Public 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

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, 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

Const WM_USER = &H400
Const TBSTYLE_FLAT = &H800

Global m_MainHWnd             As Long
Global m_PrevMainWndProc      As Long
Global gsWaitForCompleteURL   As String

Public Sub InitWebBrowser(Optional sHTML As String = "", Optional bFile = True)

   Dim sURL             As String
   Dim nVisible         As Boolean

   Static sprevHTML     As String

   On Error GoTo ERROR_InitWebBrowser
   If sprevHTML = sHTML Then Exit Sub
   sprevHTML = sHTML
   If m_MainHWnd <> 0 Then
      Call ProcUnBindFromBrowser(m_MainHWnd)
      Call SetWindowLong(m_MainHWnd, GWL_WNDPROC, m_PrevMainWndProc)
   End If
   If sHTML = "" Then
      sHTML = App.Path & "\Blank.html"
   End If
   gsWaitForCompleteURL = "(none)"

   nVisible = frmVBIDECodeDatabase.frameTab(5).Visible
   frmVBIDECodeDatabase.frameTab(5).Visible = True
   frmVBIDECodeDatabase.HTMLView.Visible = True
   m_MainHWnd = GetFocus
   Call SetFocusToBrowser(m_MainHWnd)

   m_PrevMainWndProc = GetWindowLong(m_MainHWnd, GWL_WNDPROC)
   Call SetWindowLong(m_MainHWnd, GWL_WNDPROC, AddressOf HTMLWndProc)

   On Error Resume Next
   sURL = sHTML
   If (bFile) And UCase(Left(sHTML, 7)) <> "HTTP://" Then
      If UCase(Left(sHTML, 8)) <> "FILE:///" Then
         sURL = "file:///" & sHTML
      End If
      sURL = sHTML
   End If
   frmVBIDECodeDatabase.tbAdress.Text = sURL
   frmVBIDECodeDatabase.HTMLView.Navigate sURL

   frmVBIDECodeDatabase.frameTab(5).Visible = nVisible

   Exit Sub

   Err = 0
   Exit Sub

End Sub

Public Sub EndWebBrowser()

   If m_MainHWnd = 0 Then Exit Sub
   Call ProcUnBindFromBrowser(m_MainHWnd)
   Call SetWindowLong(m_MainHWnd, GWL_WNDPROC, m_PrevMainWndProc)

End Sub

Function vbGetWindowText(ByVal hwnd) As String
   Dim c As Integer, s As String
   c = GetWindowTextLength(hwnd)
   If c <= 0 Then Exit Function
   s = String$(c, 0)
   c = GetWindowText(hwnd, s, c + 1)
   vbGetWindowText = s
End Function

Function vbGetWindowTextLine(ByVal hwnd) As String
   Dim sTitle As String, cTitle As Integer
   sTitle = vbGetWindowText(hwnd)
   ' Chop off end of multiline captions
   cTitle = InStr(sTitle, vbCr)
   vbGetWindowTextLine = IIf(cTitle, Left$(sTitle, cTitle), sTitle)
End Function

Function vbGetClassName(ByVal hwnd) As String
   Dim sName As String, cName As Integer
   sName = String$(41, 0)
   cName = GetClassName(hwnd, sName, 41)
   vbGetClassName = Left$(sName, cName)
End Function

Public Sub ShellURLDoc(hwnd As Long, httpDocName As String)
   Dim rc As Long
   Dim docPath As String
   Dim docName As String
   Dim pos As Long
   docName = Dir$(httpDocName)
   If (docName <> "") Then
      pos = InStr(1, httpDocName, docName) - 1
      If (pos > 0) Then
         docPath = Mid(httpDocName, 1, pos)
         rc = ShellExecute(hwnd, "open", httpDocName, 0, docPath, SW_SHOWDEFAULT)
      End If
   End If
End Sub

Function SetFocusToBrowser(hBrowserHwnd As Long) As Long
   Dim lStyle As Long
   Dim lResult As Long
   Dim hwnd As Long
   hwnd = hBrowserHwnd
   While (lResult = 0) And (hwnd <> 0)
      hwnd = GetWindow(hwnd, GW_CHILD)
      lStyle = GetWindowLong(hwnd, GWL_STYLE)
      lResult = lStyle And WS_VSCROLL
   SetFocusAPI (hwnd)
   SetFocusToBrowser = hwnd
End Function

Sub EnumWebWindows(Level As Integer, ByVal hwnd As Long)
   Dim CurrWnd As Long, x
   Dim count%

   'Get the hWnd of the first item in the master list
   'so we can process the task list entries (top-level only).

   GoSub DoWindow
   hwnd = GetWindow(hwnd, GW_CHILD)

   count = 0
   ' Loop while the hWnd returned by GetWindow is valid.
   While hwnd <> 0
      count = count + 1
      Call EnumWebWindows(Level + 1, hwnd)

      'Get the next task list item in the master list.
      hwnd = GetWindow(hwnd, GW_HWNDNEXT)

   Exit Sub

   Dim s As String, prevProc As Long, wndClass As String
   wndClass = vbGetWindowTextLine(hwnd)
   If wndClass = "" Then wndClass = vbGetClassName(hwnd)
   s = "{" & Hex$(hwnd) & "}" & "[" & wndClass & "]"

   ' wndClass = "HTML_Internet Explorer" for IE3
   ' wndClass = "Internet Explorer_Server" for IE4
   If hwnd <> 0 And (wndClass = "HTML_Internet Explorer" Or _
         wndClass = "Internet Explorer_Server") Then
      prevProc = GetWindowLong(hwnd, GWL_WNDPROC)
      Call SetWindowLong(hwnd, GWL_WNDPROC, AddressOf HTMLWndProc)
      prevWndProcCount = prevWndProcCount + 1
      ReDim Preserve prevWndProc(1, prevWndProcCount)
      prevWndProc(0, prevWndProcCount) = hwnd
      prevWndProc(1, prevWndProcCount) = prevProc
   End If

End Sub

Function ProcBindToBrowser(hBrowserHwnd As Long) As Long
   Dim lStyle As Long
   Dim lResult As Long
   Dim hwnd As Long, prevProc As Long

   #If bAllowRightClick = True Then
      Exit Function
   #End If

   hwnd = hBrowserHwnd
   prevWndProcCount = 0
   ReDim prevWndProc(1, prevWndProcCount)
   EnumWebWindows 0, hBrowserHwnd
   ProcBindToBrowser = hwnd

End Function

Function ProcUnBindFromBrowser(hBrowserHwnd As Long) As Long
   Dim i As Integer

   #If bAllowRightClick = True Then
      Exit Function
   #End If

   For i = 1 To prevWndProcCount
      If prevWndProc(0, i) <> 0 Then
         Call SetWindowLong(prevWndProc(0, i), GWL_WNDPROC, prevWndProc(1, i))
      End If
   prevWndProcCount = 0
   ReDim prevWndProc(1, prevWndProcCount)

End Function

Function HTMLWndProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Select Case uMsg
      Case WM_ACTIVATE:
         ' eat message
         ' eat message
      Case WM_KILLFOCUS:
         ' eat message
         ' eat message
      Case WM_RBUTTONUP:
         ' eat message
      Case Else
         Dim wndProc As Long
         ' check if messages captured for hw
         wndProc = HTMLFindWndProc(hw)
         If wndProc <> 0 Then
            ' handle captured windows messages
            HTMLWndProc = CallWindowProc(wndProc, hw, uMsg, wParam, lParam)
         End If
   End Select

End Function

Function HTMLFindWndProc(hwnd As Long) As Long
   Dim i As Long
   HTMLFindWndProc = 0
   If hwnd = m_MainHWnd Then
      ' it is handle of main window
      HTMLFindWndProc = m_PrevMainWndProc
   ElseIf prevWndProcCount > 0 Then
      For i = 1 To prevWndProcCount
         If prevWndProc(0, i) = hwnd Then
            ' it is handle of one of child windows (frames)
            HTMLFindWndProc = prevWndProc(1, i)
            Exit For
         End If
   End If

End Function


Author Comment

ID: 1453795
Worked Great!
Thanks Waty

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses

770 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