Html 将Excel VBA从InternetExplorerMedia转换为MSXML2.XMLHTTP60

我使用InternetExplorerMedium创建了一个宏，但是由于IE不稳定，并且会临时抛出错误，我想将其更改为使用MSXML2.XMLHTTP60

到目前为止，我已经成功地更改了代码的特定部分，但是我遇到了一个困难的部分。但是，这部分代码在以下位置出现错误运行时错误91：

我如何克服这个问题

下面与此查询相关的代码片段：

Sub TPMRebatePayment()


    Dim IE As New MSXML2.XMLHTTP60
    Dim HTMLdoc As MSHTML.HTMLDocument
    Dim frame As HTMLFrameElement
    Dim myurl As String


<snip code>

    'Opens IE

    myurl = "http://crmprdas02.aunz.lncorp.net:8011/sap(bD1lbiZjPTEwMCZkPW1pbg==)/bc/bsp/sap/crm_bsp_frame/entrypoint.do?appl=crmd_stlmt_rb&version=0&blview=znfl_stl&crm_bsp_restore=false"
    IE.Open "GET", myurl, False
    IE.Send


    While IE.readyState <> 4 Or IE.Busy: DoEvents: Wend

    'Loops thru entering payments
    LastRow = SourceShtTPM.Range("A" & Rows.Count).End(xlUp).Row    'Recalc last row as data has been entered

    For iRow = 3 To LastRow
        If SourceShtTPM.Range("A" & iRow) <> "" Then
            Set HTMLdoc = New HTMLDocument
            Set frame = HTMLdoc.getElementsByName("crmA")(0)

            ''' This is where the error occurs                
            Set HTMLdoc = frame.contentDocument

            HTMLdoc.getElementById("SREQ1_SR__simpleSearch__as_button").Click   'Click Search Button
            While IE.readyState <> 4 Or IE.Busy: DoEvents: Wend

            HTMLdoc.getElementById("SREQ1_SR__advancedSearch_advancedSearch_REBATE_NO").Value = SourceShtTPM.Range("A" & iRow).Value    'Enter Accrual into Rebate No. Field
            HTMLdoc.getElementById("SREQ1_SR__advancedSearch__sm_go").Click
            While IE.readyState <> 4 Or IE.Busy: DoEvents: Wend

            HTMLdoc.getElementById("SRES2_BUT_GOTO").Click      'Click Go To Button
            While IE.readyState <> 4 Or IE.Busy: DoEvents: Wend
            HTMLdoc.getElementById("EDIT_DETAILS").Click        'Then Details to enter the payment page
            While IE.readyState <> 4 Or IE.Busy: DoEvents: Wend

            AccBal = HTMLdoc.getElementById("MULT3_DETL31_MULT3_DETL31ES_ZZACCRUED_SC").Value       'Scrapes accrual balance

            If AccBal <> 0 Then
                If Right(AccBal, 1) = "-" Then                                                          'Converts to number
                    SourceShtTPM.Range("E" & iRow).Value = "-" & Left(AccBal, Len(AccBal) - 1)
                    Else: SourceShtTPM.Range("E" & iRow).Value = "-" & AccBal
                End If

                If SourceShtTPM.Range("H" & iRow).Value > 0 Then       'Confirms if enough money to pay
                    HTMLdoc.getElementById("MULT3_DETL31_MULT3_DETL31ES_ZZAMOUNT").Value = Round(SourceShtTPM.Range("H" & iRow).Value, 2)   'Enters "Amount to be Paid"
                    HTMLdoc.getElementById("MULT3_DETL31_MULT3_DETL31ES_ZZCLAIMNO_SC").Value = SourceShtCLM.Range("A2").Value       'Enters claim no.
                    HTMLdoc.getElementById("MULT3_MEDL32_BUT_ZST_CPY_RT").Click     'Click button to distribute
                    While IE.readyState <> 4 Or IE.Busy: DoEvents: Wend
                    HTMLdoc.getElementById("ZCR_COPY_TO_SKU_RATE").Click            'distributes to sku
                    While IE.readyState <> 4 Or IE.Busy: DoEvents: Wend
                    HTMLdoc.getElementById("MULT3_MEDL32_BUT_ZSTL_COPY").Click      'Click button to distribute
                    While IE.readyState <> 4 Or IE.Busy: DoEvents: Wend
                    HTMLdoc.getElementById("ZCR_COPY_TO_SKU_AMNT").Click            'distributes to sku
                    While IE.readyState <> 4 Or IE.Busy: DoEvents: Wend
                    HTMLdoc.getElementById("MULT3_MEDL32_ZSTL_PART_SETTLE").Click   'Clicks Pay Claim
                    While IE.readyState <> 4 Or IE.Busy: DoEvents: Wend
                    'The line below will save the rebate payment.
                    'DO NOT CHANGE UNLESS CODE IS 100%
                    'HTMLdoc.getElementById("MULT3_MEDL32_ZCR_STLMT_SAVE").Click    'Clicks Save
                    'While IE.readyState <> 4 Or IE.Busy: DoEvents: Wend

                    SourceShtTPM.Range("C" & iRow) = Split(IE.document.getElementsByName("crmA")(0).contentDocument.getElementById("APLG0_lnk").innerText, Chr$(32))(3)

                    'Col "Y" = entered commentary
                    SourceShtTPM.Range("D" & iRow).Value = "Claim Paid"
                Else
                    'Col "Y" = payment amount to enter
                    SourceShtTPM.Range("D" & iRow).Value = "Not Paid"
                End If
            Else
                SourceShtTPM.Range("D" & iRow).Value = "No money in accrual"
            End If

        IE.navigate "http://crmprdas02.aunz.lncorp.net:8011/sap(bD1lbiZjPTEwMCZkPW1pbg==)/bc/bsp/sap/crm_bsp_frame/entrypoint.do?appl=crmd_stlmt_rb&version=0&blview=znfl_stl&crm_bsp_restore=false"
        While IE.readyState <> 4 Or IE.Busy: DoEvents: Wend
        Set HTMLdoc = Nothing

        End If

    Next iRow


   IE.Quit

   <snip code>

End Sub

---

您可以删除while wend循环。将XMLHTTP响应读入html文档对象。我通常在途中解码

Dim sresponse As String, html As HTMLDocument, myUrl
myUrl = "abc.com"

With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", myUrl, False
    .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
    .send
   sresponse = StrConv(.responseBody, vbUnicode)
End With

Set html = New HTMLDocument
html.body.innerHTML = sresponse

---

然后测试内容，查看框架是否存在并包含信息。

您创建了HTMLdoc，然后从中读取，但它没有内容&为空。该错误可能是因为帧为空。您需要将下载的HTML文本分配给文档，比如HTMLdoc.body.innerHTML=htmlTextyep，您是对的，我将鼠标悬停在框架上，is=nothing。如何以及在何处将HTMLdoc.body.innerHTML=htmlText合并到代码中？在设置HTMLdoc=New HTMLDocument和debug.print后，我使用了HTMLdoc.body.innerText=IE.responseText，该链接在浏览器中对我不起作用。它看起来是内部的。嗨@qharr是的，它是内部的。。我将在html.Body.innerHTML=sresponse运行时错误“601”应用程序定义的错误或对象定义的错误处进行测试并还原返回错误。您是否检查了sresponse？Debug.Print sresponse生成了一些文本。。我的问题是CRM和我升级的SAP不兼容，因此此代码无法工作。在理解了这一点并测试了以上各项之后，它就可以工作了。谢谢你的帮助，再次对耽搁表示歉意。

Dim sresponse As String, html As HTMLDocument, myUrl
myUrl = "abc.com"

With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", myUrl, False
    .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
    .send
   sresponse = StrConv(.responseBody, vbUnicode)
End With

Set html = New HTMLDocument
html.body.innerHTML = sresponse