• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 306
  • Last Modified:

Run-time error 91during Internet Explorer .Document reference from VBA

Hello,
  I need to write an app to get data in and out of tools with a web front end.  The pages are kind of complicated, and run java, asp... I tried perl::LWP but got stumped by embeded java scritps, and so decided to use IE, and write a vb script to control it (hope that's the right way to go).  I am using VBA out of excel 2003 Pro, sp2.

I am getting a Run-time error 91 when i try to execute any methods out of my .Document object, but I get the correct answer when I reference the .Document.Title object.  .Document.LastChild also errors out... The code is below, in the order it gets called:
mdlMain:
  Option Explicit
  Public goIe As InternetExplorer 'Ie is the name of my global object for browser - EMPTY at this time!!!
  Public goIeDoc As Object
  Public Function main()
     frmMain.Show
     GetIE
      With goIe
         .Visible = True
      End With
     ' user clicks a button to call mdlOther.my_func
     main = 1
  End Function

mdlOther
Option Explicit
Dim cframes As Object
   Public Function my_func()
      ' go to some websites...
      mdlIe.Navigate ("someurl")  ' snipped - it goes there just fine, can see on screen.
     
      'run an asp script - snipped -runs just fine, again can see on screen.
       mdlIe.Navigate ("someurl/some.asp")
   
       'Select the correct project
       Set goIeDoc = goIe.Document
       sTitle = goIeDoc.Title 'works just fine.
       cframes = goIeDoc.LastChild '<--- ERROR
       'cframes = goIeDoc.getElementsByName("_TopMenu") '<--- same ERROR
   End Function

mdlIe
   'credit goes to a guy from some web site I found this on :)
    Public Sub GetIE()
       'Makes sure goIe is created prior to being used.
        If goIe Is Nothing Then
            Set goIe = New InternetExplorer
            goIe.Visible = False
            'I don't know why this causes problems, can supress the warn manually for now...
            'goIe.Silent = True
       End If
   End Sub
Public Sub Navigate(loc As String)
       ' Navigate to loc
        Call goIe.Navigate(loc)
        Call LoadPage
        End Sub
Public Sub LoadPage()
   Do While goIe.Busy Or goIe.ReadyState <> READYSTATE_COMPLETE
    DoEvents
   Loop
End Sub

I am stumped.  Thanks in advance for the help...
0
apiraner
Asked:
apiraner
1 Solution
 
zorvek (Kevin Jones)ConsultantCommented:
I can't see anything wrong with your code. However, I will post a class i have used in the past to load and manipulate web pages. Perhaps you can find some answers below. Ir just use the class as-is.

Option Explicit

' Requires reference to Microsoft Internet Controls and Microsoft HTML Object Library

Public ID As Variant
Public RetryCount As Long
Public KillCount As Long
Public TimeoutSeconds As Long
Public RetryTimeoutSeconds As Long

Private WithEvents mITC As InternetExplorer
Attribute mITC.VB_VarHelpID = -1
Private mURL As String
Private mTimeoutTime As Date

Public Event Idle(ByRef Cancel As Boolean)

Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" ( _
   ByVal pCaller As Long, _
   ByVal szURL As String, _
   ByVal szFileName As String, _
   ByVal dwReserved As Long, _
   ByVal lpfnCB As Long) As Long

Private Sub Class_Initialize()

   TimeoutSeconds = 20
   RetryTimeoutSeconds = 5
   Set mITC = New InternetExplorer

End Sub

Public Function DownloadImage(ByVal URL As String, ByVal TargetPath As String) As Long

    DownloadImage = URLDownloadToFile(0, URL, TargetPath, 0, 0)
   
End Function

Public Function DownloadDocumentImage(ByVal ReferenceText As String, ByVal TargetPath As String) As Boolean

   Dim Index As Long
   Dim Result As Long
   
   For Index = 0 To mITC.document.images.Length - 1
      If FindString(ReferenceText, mITC.document.images(Index).href) > 0 Then
         Result = DownloadImage(mITC.document.images(Index).href, TargetPath)
         If Result = 0 Then
            DownloadDocumentImage = True
            Exit Function
         End If
      End If
   Next Index

End Function

Public Function IsComplete() As Boolean

   Dim ReadyState As Long

   On Error Resume Next
   ReadyState = mITC.ReadyState
   If (Err.Number = 426 Or ReadyState = READYSTATE_COMPLETE) And Not mITC.Busy Then
      IsComplete = True
   End If
   
End Function

Public Function IsError() As Boolean

   Dim ReadyState As Long

   On Error Resume Next
   ReadyState = mITC.ReadyState
   If Err.Number = 426 Or IsProcessHung(mITC.HWnd) Then
      IsError = True
   End If

End Function

Public Function IsTimeout() As Boolean

   If Now > mTimeoutTime Then
      IsTimeout = True
   End If

End Function

Public Property Get ITC() As InternetExplorer

   Set ITC = mITC

End Property

Public Sub KillQuery()
   
   If IsComplete Then Exit Sub
   On Error Resume Next
   KillHWndProcess mITC.HWnd
   KillCount = KillCount + 1

End Sub

Public Sub Navigate(ByVal URL As String)

   If Not URL = mURL Then
      RetryCount = 0
   End If
   
   If Not URL = "" Then
      On Error Resume Next
      mITC.Navigate URL
      If Err.Number = 462 Then
         On Error GoTo 0
         Set mITC = Nothing
         Set mITC = New InternetExplorer
         mITC.Navigate URL
      End If
      mURL = URL
   End If
   
   mTimeoutTime = Now + TimeSerial(0, 0, TimeoutSeconds)
   
End Sub

Public Sub NavigateForm( _
   ByVal FormIndex As Long, _
   Optional ByVal ParameterName1 As Variant, _
   Optional ByVal ParameterValue1 As Variant, _
   Optional ByVal ParameterName2 As Variant, _
   Optional ByVal ParameterValue2 As Variant, _
   Optional ByVal ParameterName3 As Variant, _
   Optional ByVal ParameterValue3 As Variant, _
   Optional ByVal ParameterName4 As Variant, _
   Optional ByVal ParameterValue4 As Variant, _
   Optional ByVal ParameterName5 As Variant, _
   Optional ByVal ParameterValue5 As Variant, _
   Optional ByVal ParameterName6 As Variant, _
   Optional ByVal ParameterValue6 As Variant)
   
' Fills in fields on a form and submits the form.

   Dim FieldIndex As Long
   
   If PageText = "" Then Exit Sub
   If mITC.document.forms.Length = 0 Then Exit Sub
   If mITC.document.forms.Item(FormIndex).Length = 0 Then Exit Sub

   ' Fill in form fields
   If Not IsMissing(ParameterName1) And Not IsMissing(ParameterValue1) Then
      SetFormField FormIndex, ParameterName1, ParameterValue1
   End If
   If Not IsMissing(ParameterName2) And Not IsMissing(ParameterValue2) Then
      SetFormField FormIndex, ParameterName2, ParameterValue2
   End If
   If Not IsMissing(ParameterName3) And Not IsMissing(ParameterValue3) Then
      SetFormField FormIndex, ParameterName3, ParameterValue3
   End If
   If Not IsMissing(ParameterName4) And Not IsMissing(ParameterValue4) Then
      SetFormField FormIndex, ParameterName4, ParameterValue4
   End If
   If Not IsMissing(ParameterName5) And Not IsMissing(ParameterValue5) Then
      SetFormField FormIndex, ParameterName5, ParameterValue5
   End If
   If Not IsMissing(ParameterName6) And Not IsMissing(ParameterValue6) Then
      SetFormField FormIndex, ParameterName6, ParameterValue6
   End If
   
   ' Click the form button
   For FieldIndex = 0 To mITC.document.forms.Item(FormIndex).Length - 1
      If mITC.document.forms.Item(FormIndex).Item(FieldIndex).Type = "submit" Then
         mITC.document.forms.Item(FormIndex).Item(FieldIndex).Click
         mTimeoutTime = Now + TimeSerial(0, 0, TimeoutSeconds)
         Exit Sub
      End If
   Next FieldIndex
   
End Sub

Public Property Get PageDocument() As HTMLDocument

   On Error Resume Next
   Set PageDocument = mITC.document

End Property

Public Property Get PageHTML() As String

   On Error Resume Next
   PageHTML = mITC.document.Body.innerHTML

End Property

Public Property Get PageText() As String

   On Error Resume Next
   PageText = mITC.document.Body.innerText

End Property

Public Sub Post( _
   ByVal URL As String, _
   Optional ByVal ParameterName1 As Variant, _
   Optional ByVal ParameterValue1 As Variant, _
   Optional ByVal ParameterName2 As Variant, _
   Optional ByVal ParameterValue2 As Variant, _
   Optional ByVal ParameterName3 As Variant, _
   Optional ByVal ParameterValue3 As Variant, _
   Optional ByVal ParameterName4 As Variant, _
   Optional ByVal ParameterValue4 As Variant, _
   Optional ByVal ParameterName5 As Variant, _
   Optional ByVal ParameterValue5 As Variant, _
   Optional ByVal ParameterName6 As Variant, _
   Optional ByVal ParameterValue6 As Variant)
   
' Issues a post command.

   Dim PostData As New clsTokensString
   Dim PostDataParm() As Byte
   
   ' Build post data
   PostData.Delimiters = "&"
   If Not IsMissing(ParameterName1) And Not IsMissing(ParameterValue1) Then
      PostData.Append ParameterName1 & "=" & ParameterValue1
   End If
   If Not IsMissing(ParameterName2) And Not IsMissing(ParameterValue2) Then
      PostData.Append ParameterName2 & "=" & ParameterValue2
   End If
   If Not IsMissing(ParameterName3) And Not IsMissing(ParameterValue3) Then
      PostData.Append ParameterName3 & "=" & ParameterValue3
   End If
   If Not IsMissing(ParameterName4) And Not IsMissing(ParameterValue4) Then
      PostData.Append ParameterName4 & "=" & ParameterValue4
   End If
   If Not IsMissing(ParameterName5) And Not IsMissing(ParameterValue5) Then
      PostData.Append ParameterName5 & "=" & ParameterValue5
   End If
   If Not IsMissing(ParameterName6) And Not IsMissing(ParameterValue6) Then
      PostData.Append ParameterName6 & "=" & ParameterValue6
   End If
   
   PostDataParm = StrConv(EncodeURL(PostData.Value), vbFromUnicode)
   
   On Error Resume Next
   
   mITC.Navigate _
      URL, _
      PostData:=PostDataParm, _
      Headers:="Content-Type: application/x-www-form-urlencoded" & vbCrLf
   On Error GoTo 0

   If Err.Number = 462 Then
      Set mITC = New InternetExplorer
      mITC.Navigate _
         URL, _
         PostData:=PostDataParm, _
         Headers:="Content-Type: application/x-www-form-urlencoded" & vbCrLf
   End If
   
   mTimeoutTime = Now + TimeSerial(0, 0, TimeoutSeconds)
   
   DoEvents

End Sub

Public Sub Refresh()

   On Error Resume Next
   mITC.Refresh
   If Err.Number = 462 Then
      On Error GoTo 0
      Set mITC = Nothing
      Set mITC = New InternetExplorer
      mITC.Navigate mURL
   End If
   mTimeoutTime = Now + TimeSerial(0, 0, TimeoutSeconds)

End Sub

Public Sub Retry()

   If Not IsComplete Then
      StopQuery
   End If
   Navigate mURL
   RetryCount = RetryCount + 1

End Sub

Public Sub SetFormField( _
   ByVal FormIndex As Long, _
   ByVal FieldName As String, _
   ByVal FieldValue As String)
   
' Sets the field value in the specified form.

   Dim FieldIndex As Long

   For FieldIndex = 0 To mITC.document.forms.Item(FormIndex).Length - 1
      If mITC.document.forms.Item(FormIndex).Item(FieldIndex).Name = FieldName Then
         mITC.document.forms.Item(FormIndex).Item(FieldIndex).Value = FieldValue
         Exit Sub
      End If
   Next FieldIndex
   
End Sub

Public Property Get StatusText() As String

   On Error Resume Next
   StatusText = mITC.StatusText

End Property

Public Sub StopQuery()

   If IsProcessHung(mITC.HWnd) Then
      KillQuery
   Else
      mITC.stop
   End If

End Sub

Public Property Let URL(ByVal URL As String)

   mURL = URL

End Property

Public Sub WaitQuery(Optional ByVal Pictures As Boolean = False)

   Dim Cancel As Boolean
   Dim RetryTimeoutTimer As Date

   RetryTimeoutTimer = Now + TimeSerial(0, 0, RetryTimeoutSeconds)
   Do
      DoEvents
      Sleep 1
      If IsProcessHung(mITC.HWnd) Then
         KillQuery
         mTimeoutTime = 0
      ElseIf Not Pictures Then
         If FindString("Downloading picture", StatusText) > 0 Then
            StopQuery
         End If
      End If
      If Now > RetryTimeoutTimer Then
         Retry
         RetryTimeoutTimer = Now + TimeSerial(0, 0, RetryTimeoutSeconds)
      End If
      RaiseEvent Idle(Cancel)
      If Cancel Then
         Exit Sub
      End If
   Loop Until IsComplete Or IsTimeout
   If IsTimeout Then
      KillQuery
      Navigate "about:blank"
      Do
         DoEvents
         Sleep 1
      Loop Until IsComplete
   End If

End Sub

Kevin
0
 
Computer101Commented:
Forced accept.

Computer101
EE Admin
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now