VBA EXCEL HTML - извлечение данных с веб-сайта в пределах фрейма - PullRequest
Новая
       8

VBA EXCEL HTML - извлечение данных с веб-сайта в пределах фрейма

0 голосов
/ 21 октября 2018

Справочная информация

Я около 10 недель, чтобы стать самоучкой VBA.Приведенный ниже код, который я только что взял на прошлой неделе, касается 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 изображения «Проверяющих элементов» в сети, из которых я пытаюсь собрать информацию.Я хочу, чтобы текст "Дата начала промоушена еще не достигнута".

Я хотел бы помочь, пожалуйста.И если возможно, я хотел бы получить объяснение, чтобы я мог понять предоставленный код.Чем больше я учусь, тем больше я могу помогать другим.

Pic 1/2

Pic 2/2

1 Ответ

0 голосов
/ 21 октября 2018

Редактировать:

В вашем пастбине он просто доступен по идентификатору 

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

Для элементов с родительским фреймом и тегами формы: Вы должны учитывать frameв вашем пути выбора.form возможно.

Чтобы учитывать только фрейм и использовать идентификатор целевого элемента, вы должны использовать синтаксис, такой как: 

 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...