簡體   English   中英

VBA EXCEL HTML - 從一個框架內的網站中抓取數據,從一個跨度

[英]VBA EXCEL HTML - Scraping data from website within a frame, from a span

背景

我大約 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 張圖片。 我想要文本“促銷開始日期尚未到達”。

我希望得到一些幫助。 如果可能的話,我想要一個解釋,以便我可以理解所提供的代碼。 我學得越多,我就越能幫助別人。

圖1/2

圖2/2

編輯:

在您的 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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM