Internet Explorer VBAオートメーションエラー：呼び出されたオブジェクトがクライアントから切断されました

Question

Excelから値を読み取り、内部Webベースのシステムで検索し、結果をExcelに保存するコードを作成しようとしています。 Excelを問題なく読み込み、問題なくInternet Explorerを開きますが、開かれた内容を参照しようとすると、上記のエラーが発生します。 "ie.Navigate url"行は機能しますが、次の行 "Set DOC = ie.Document"がエラーを生成します。これを引き起こしていることに関するアイデアは？

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

は、問題を修正しました：

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 

Answer 1

に変更する：ここに私のコードです。加えて、コメントに記載されたDoループを追加する必要がありました。

Do 
    DoEvents 
Loop Until ie.ReadyState = READYSTATE_COMPLETE