Question

背景

自学VBA大约需要10周的时间。下面的代码是我上周才刚刚获得的，因为它与IE / HTML有关。现在，通过单击按钮和抓取数据使该过程自动化，到目前为止，我已经走了很多。剩下的一件事我无法解决自己的生活。而且我知道这很复杂，但是我不够熟练，无法解决..

我的代码如下：

Sub TPMRebatePayment()


    Dim IE As New InternetExplorerMedium
    Dim HTMLdoc As HTMLDocument
    Dim frame As HTMLFrameElement
    Dim imgShowAdvSearch As HTMLImg
    Dim imgGoTo As HTMLImg
    Dim imgEditDet As HTMLImg
    Dim wkbSourceWB As Workbook
    Dim SourceShtClm As Worksheet
    Dim LastRow As Long
    'Dim LastRow_Clm As Long    'Do I need to DIM this??
    'Dim LastRow_TPM As Long    'Do I need to DIM this??
    Dim cRow1 As Long
    Dim cRow2 As Long
    Dim iRow As Long
    Dim jRow As Long
    Dim dblStartTime As Double         'time elapsed counter
    Dim strMinutesElapsed As String

    dblStartTime = Timer

    Set wkbSourceWB = ThisWorkbook     'Set workbook
    Set SourceShtClm = wkbSourceWB.Sheets("Claim Summary")
    Set SourceShtTPM = wkbSourceWB.Sheets("TPM Payment")

    response = MsgBox("Have you open IE and logged onto CRM?", vbYesNo, "Internet Explorer Question")
    If response = vbNo Then
    Exit Sub
    End If

    'Cleares data from "TPM Payment" tab
    SourceShtTPM.Rows("4:" & Rows.Count).Delete          'deletes data
    SourceShtTPM.Range("A3:B3, D3:E3, J3").ClearContents            'clears data

    'Copies Accruals from "Promo Claims" tab to "TPM Payment" tab
    LastRow_Clm = SourceShtClm.Range("T" & Rows.Count).End(xlUp).Row

    For cRow1 = 4 To LastRow_Clm
        If SourceShtClm.Range("P" & cRow1) = "" Then
            LastRow_TPM = SourceShtTPM.Range("A" & Rows.Count).End(xlUp).Row
            SourceShtClm.Range("N" & cRow1).Copy SourceShtTPM.Range("A" & LastRow_TPM + 1)
            SourceShtClm.Range("O" & cRow1).Copy SourceShtTPM.Range("B" & LastRow_TPM + 1)
        End If
    Next cRow1

    For cRow2 = 4 To LastRow_Clm
        If SourceShtClm.Range("S" & cRow2) = "" Then
            LastRow_TPM = SourceShtTPM.Range("A" & Rows.Count).End(xlUp).Row    'Recalc last row as data has been entered
            SourceShtClm.Range("Q" & cRow2).Copy SourceShtTPM.Range("A" & LastRow_TPM + 1)
            SourceShtClm.Range("R" & cRow2).Copy SourceShtTPM.Range("B" & LastRow_TPM + 1)
        End If
    Next cRow2

    'Copies formulas in TPM tab
    LastRow_TPM = SourceShtTPM.Range("A" & Rows.Count).End(xlUp).Row    'Recalc last row as data has been entered
    SourceShtTPM.Range("C3").Copy SourceShtTPM.Range("C" & LastRow_TPM)
    SourceShtTPM.Range("F3:I3").Copy SourceShtTPM.Range("F4:I" & LastRow_TPM)

    'Opens IE
    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"
    IE.Visible = True
    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 = IE.document
            Set frame = HTMLdoc.getElementsByName("crmA")(0)
            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 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"
                While IE.readyState <> 4 Or IE.Busy: DoEvents: Wend
                HTMLdoc.getElementById("MULT3_DETL31_MULT3_DETL31ES_ZZCLAIMNO_SC").Value = SourceShtTPM.Range("A2").Value       'Enters claim no.
                While IE.readyState <> 4 Or IE.Busy: DoEvents: Wend
                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 REMOVE ' UNLESS CODE IS 100%
                'HTMLdoc.getElementById("MULT3_MEDL32_ZCR_STLMT_SAVE").Click    'Clicks Save
                'While IE.readyState <> 4 Or IE.Busy: DoEvents: Wend


                'THIS IS WHERE I NEED HELP!!!


                SourceShtTPM.Range("J" & iRow) = HTMLdoc.getElementsByClassName("urTxtStd").innerText     'Gets text


                'END OF HELP


                '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

        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

    strMinutesElapsed = Format((Timer - dblStartTime) / 86400, "hh:mm:ss")        'stops timer - Determine how many seconds code took to run

    MsgBox "This code ran successfully in " & strMinutesElapsed, vbInformation        'Msg box for elapsed time & Claims consldaited

End Sub

问题

下面是我试图从中获取信息的网络“检查元素”的2张图片。我希望输入文字“尚未到促销开始日期。”

请给我一些帮助。如果可能的话，我想解释一下，以便我理解所提供的代码。我学得越多，就越能帮助别人。

Answer 1

编辑：

在您的pastebin中，只需通过ID即可访问

Debug.Print ie.document.getElementById("APLG0_lnk").innerText

对于带有父框架和表单标签的元素：您必须在选择路径中考虑frame。 form可能。

要仅考虑框架并使用目标元素的ID，可以使用以下语法：

 Debug.Print Ie.document.getElementsByName("crmA")(0).contentDocument.getElementById("APLG0_lnk").innerText

类似地，诸如以下语法：

Debug.Print Ie.document.getElementsByTagName("frame")(0).contentDocument.getElementById("APLG0_1nk").innerText

在不太可能需要说明form的情况下，类似：

Debug.Print Ie.document.getElementsByName("crmA")(0).contentDocument.querySelector("form #APLG0_lnk").innerText

VBA EXCEL HTML-从跨范围的框架中的网站抓取数据

1 个答案: