Solved

NavigateTo(URL) mehtod

Posted on 1999-01-04
4
194 Views
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
s.NavigateTo("http://www.somewebsite.com")

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!


0
Comment
Question by:alfaromeo
  • 2
  • 2
4 Comments
 
LVL 14

Expert Comment

by:waty
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

0
 
LVL 1

Author Comment

by:alfaromeo
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
     s.navigateTo("my_path\page1.html")
 else
    s.navigateTo("my_path\page2.html")
 end if


0
 
LVL 14

Accepted Solution

by:
waty earned 50 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 TB_SETSTYLE = WM_USER + 56
Const TB_GETSTYLE = WM_USER + 57
Const TBSTYLE_FLAT = &H800
Const TBSTYLE_ALTDRAG = &H400

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
   frmVBIDECodeDatabase.HTMLView.SetFocus
   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
   Else
      sURL = sHTML
   End If
   
   frmVBIDECodeDatabase.tbAdress.Text = sURL
   frmVBIDECodeDatabase.HTMLView.Navigate sURL

   frmVBIDECodeDatabase.frameTab(5).Visible = nVisible

   Exit Sub

ERROR_InitWebBrowser:
   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
   Wend
   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)
   Wend

   Exit Sub

DoWindow:
   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
   Return

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
   Next
   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
      Case WM_ACTIVATEAPP:
         ' eat message
      Case WM_KILLFOCUS:
         ' eat message
      Case WM_RBUTTONDOWN:
         ' 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
      Next
   End If

End Function

0
 
LVL 1

Author Comment

by:alfaromeo
ID: 1453795
Worked Great!
Thanks Waty
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
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…
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…

760 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

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now