Question

I created a macro using InternetExplorerMedium however due to IE being unstable and throwing errors ad hoc I want to change this to use MSXML2.XMLHTTP60

I have been successful in changing the specific parts of code thus far however I have come across a part where I am struggling. This part of code however I am getting an error runtime error 91 at:

Set HTMLdoc = frame.contentDocument ' <----- error debug here

How do I overcome this?

Snippets of code below relating to this query:

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

Answer 1

您可以删除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

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

converting Excel VBA from InternetExplorerMedium to MSXML2.XMLHTTP60

1 个答案: