Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium


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
  • 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

Independent Software Vendors: 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

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Suggested Courses
Course of the Month14 days, 3 hours left to enroll

580 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