Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Internet Explorer VBA Automation Error: The object Invoked has disconnected from its clients

I'm trying to write code that will read a value from Excel, look it up in an internal web based system and store the results back in the Excel. It reads the Excel with no problem, opens Internet Explorer with no problem, but when I then try to reference what's been opened, I get the above error. The line "ie.Navigate url" works, but the next line "Set DOC = ie.Document" generates the error. Any ideas on what's causing this? Here's my code:

Public Sub getClient()
  Dim xOpen As Boolean
  xOpen = False
  Dim row As Long

  Dim xL As Excel.Application
  Set xL = New Excel.Application
  xL.Visible = False
  Dim wb As Excel.Workbook
  Dim sh As Excel.Worksheet

  'Change the name as needed, out put in some facility to input it or 
  'process multiples...
  Dim filename As String
  filename = "auditLookup.xlsx"
  Set wb = xL.Workbooks.Open(getPath("Audit") + filename)
  xOpen = True
  Set sh = wb.Sheets(1)

  Dim ie As Variant
  Set ie = CreateObject("InternetExplorer.Application")
  ie.Visible = True

  Dim DOC As HTMLDocument
  Dim idx As Integer
  Dim data As String

  Dim links As Variant
  Dim lnk As Variant
  Dim iRow As Long
  iRow = 2            'Assume headers

  Dim clientName As String
  Dim clientID As String
  Dim nameFound As Boolean
  Dim idFound As Boolean
  Dim url As String

  While sh.Cells(iRow, 1) <> ""
    'Just in case these IDs are ever prefixed with zeroes, I'm inserting 
    'some random character in front, but removing it of course when 
    'processing.
    url = "https://.../" +  mid(sh.Cells(iRow, 1), 2)
    ie.navigate url
    Set DOC = ie.Document

    'Search td until we find "Name:" then the next td will be the name. 
    'Then search for "P1 ID (ACES):" and the next td with be that.
    Set links = DOC.getElementsByTagName("td")
    clientName = ""
    clientID = ""
    nameFound = False
    idFound = False
    For Each lnk In links
        data = lnk.innerText
        If nameFound Then
            clientName = data
        ElseIf idFound Then
            clientID = data
        End If
        If nameFound And idFound Then
            Exit For
        End If

        If data = "Name:" Then
            nameFound = True
        ElseIf data = "P1 ID (ACES):" Then
            idFound = True
        End If
    Next
    sh.Cells(iRow, 2) = clientName
    sh.Cells(iRow, 2) = clientID
    iRow = iRow + 1
  Wend

  Set ie = Nothing
  If xOpen Then
    wb.Save
    Set wb = Nothing
    xL.Quit
    Set xL = Nothing
    Set sh = Nothing
    xOpen = False
  End If
Exit Sub
like image 480
PKatona Avatar asked Feb 22 '17 22:02

PKatona


1 Answers

Changing to:

Dim ie As InternetExplorer
Set ie = New InternetExplorerMedium
...

Solved the problem. Plus I did need to add back the Do loop mentioned in the comments:

Do
    DoEvents
Loop Until ie.ReadyState = READYSTATE_COMPLETE
like image 157
PKatona Avatar answered Sep 28 '22 07:09

PKatona