source

VBA에서 HTML 컨텐츠 구문 분석

factcode 2023. 10. 26. 21:51
반응형

VBA에서 HTML 컨텐츠 구문 분석

HTML 파싱과 관련된 질문이 있습니다.일부 제품이 있는 웹 사이트가 있으며 현재 스프레드시트의 페이지 내 텍스트를 파악하고 싶습니다.이 스프레드시트는 크기는 꽤 크지만 항목 Nbr 세 번째 열에 포함되어 있습니다. 14번째 열에 텍스트가 있고 하나의 행이 하나의 제품(아이템)에 해당하는 것으로 예상합니다.

내 생각은 태그 뒤에 있는 내부 텍스트 안에 있는 웹페이지에서 '소재'를 가져오는 것입니다.ID 번호는 페이지마다 바뀝니다(가끔씩).

웹사이트 구조는 다음과 같습니다.

<div style="position:relative;">
    <div></div>
    <table id="list-table" width="100%" tabindex="1" cellspacing="0" cellpadding="0" border="0" role="grid" aria-multiselectable="false" aria-labelledby="gbox_list-table" class="ui-jqgrid-btable" style="width: 930px;">
        <tbody>
            <tr class="jqgfirstrow" role="row" style="height:auto">
                <td ...</td>
                <td ...</td>
            </tr>
            <tr role="row" id="1" tabindex="-1" class="ui-widget-content jqgrow ui-row-ltr">
                <td ...</td>
                <td ...</td>
            </tr>
            <tr role="row" id="2" tabindex="-1" class="ui-widget-content jqgrow ui-row-ltr">
                <td ...</td>
                <td ...</td>
            </tr>
            <tr role="row" id="3" tabindex="-1" class="ui-widget-content jqgrow ui-row-ltr">
                <td ...</td>
                <td ...</td>
            </tr>
            <tr role="row" id="4" tabindex="-1" class="ui-widget-content jqgrow ui-row-ltr">
                <td ...</td>
                <td ...</td>
            </tr>
            <tr role="row" id="5" tabindex="-1" class="ui-widget-content jqgrow ui-row-ltr">
                <td ...</td>
                <td ...</td>
            </tr>
            <tr role="row" id="6" tabindex="-1" class="ui-widget-content jqgrow ui-row-ltr">
                <td ...</td>
                <td ...</td>
            </tr>
            <tr role="row" id="7" tabindex="-1" class="ui-widget-content jqgrow ui-row-ltr">
                <td role="gridcell" style="padding-left:10px" title="Material" aria-describedby="list-table_">Material</td>
                <td role="gridcell" style="" title="600D polyester." aria-describedby="list-table_">600D polyester.</td>
            </tr>           
            <tr ...>
            </tr>
        </tbody>
    </table> </div>

그 결과 "600D 폴리에스터"를 구매하고 싶습니다.

작동하지 않는 내 코드 조각은 다음과 같습니다.

Sub ParseMaterial()

    Dim Cell As Integer
    Dim ItemNbr As String

    Dim AElement As Object
    Dim AElements As IHTMLElementCollection
Dim IE As MSXML2.XMLHTTP60
Set IE = New MSXML2.XMLHTTP60

Dim HTMLDoc As MSHTML.HTMLDocument
Dim HTMLBody As MSHTML.HTMLBody

Set HTMLDoc = New MSHTML.HTMLDocument
Set HTMLBody = HTMLDoc.body

For Cell = 1 To 5                            'I iterate through the file row by row

    ItemNbr = Cells(Cell, 3).Value           'ItemNbr isin the 3rd Column of my spreadsheet

    IE.Open "GET", "http://www.example.com/?item=" & ItemNbr, False
    IE.send

    While IE.ReadyState <> 4
        DoEvents
    Wend

    HTMLBody.innerHTML = IE.responseText

    Set AElements = HTMLDoc.getElementById("list-table").getElementsByTagName("tr")
    For Each AElement In AElements
        If AElement.Title = "Material" Then
            Cells(Cell, 14) = AElement.nextNode.value     'I write the material in the 14th column
        End If
    Next AElement

        Application.Wait (Now + TimeValue("0:00:2"))

Next Cell

도와주셔서 감사합니다!

올바른 방향으로 나아가기를 희망하는 몇 가지 사항이 있습니다.

  • 정리: 준비 상태 속성 테스트 루프를 제거합니다.readystate 속성에 의해 반환되는 값은 이 컨텍스트에서 변경되지 않습니다. 코드는 전송 지시 후 일시 중지되며, 서버 응답이 수신되거나 수신되지 않은 경우에만 재개됩니다.이에 따라 준비 상태 속성이 설정되고 코드가 실행을 재개합니다.준비 상태를 테스트해야 하지만 루프는 불필요합니다.

  • 올바른 HTML 요소를 대상으로 합니다. 당신은 트리 요소를 통해 검색하고 있습니다. 코드에서 이러한 요소를 사용하는 논리는 실제로 td 요소를 가리키는 것처럼 보입니다.

  • 속성을 사용 중인 개체에 실제로 사용할 수 있는지 확인합니다. 이 작업을 돕기 위해 모든 변수를 일반 개체가 아닌 특정 개체로 선언합니다.이렇게 하면 지능이 활성화됩니다.관련 라이브러리에 정의된 개체의 실제 이름을 처음부터 찾기 어렵다면 일반 개체로 선언하고 코드를 실행한 다음 디버그 창에 유형 이름(your_object)을 인쇄하여 개체 유형을 검사합니다.그러면 당신이 가는 길에

아래에 도움이 될 만한 코드도 포함시켰습니다.그래도 작동이 안 되고 URL을 공유할 수 있다면 그렇게 해주세요.

Sub getInfoWeb()

    Dim cell As Integer
    Dim xhr As MSXML2.XMLHTTP60
    Dim doc As MSHTML.HTMLDocument
    Dim table As MSHTML.HTMLTable
    Dim tableCells As MSHTML.IHTMLElementCollection
    
    Set xhr = New MSXML2.XMLHTTP60
   
    For cell = 1 To 5
        
        ItemNbr = Cells(cell, 3).Value
        
        With xhr
        
            .Open "GET", "http://www.example.com/?item=" & ItemNbr, False
            .send
            
            If .readyState = 4 And .Status = 200 Then
                Set doc = New MSHTML.HTMLDocument
                doc.body.innerHTML = .responseText
            Else
                MsgBox "Error" & vbNewLine & "Ready state: " & .readyState & _
                vbNewLine & "HTTP request status: " & .Status
            End If
            
        End With
        
        Set table = doc.getElementById("list-table")
        Set tableCells = table.getElementsByTagName("td")
        
        For Each tableCell In tableCells
            If tableCell.getAttribute("title") = "Material" Then
                Cells(cell, 14).Value = tableCell.NextSibling.innerHTML
            End If
        Next tableCell
    
    Next cell
    
End Sub

EDIT: 아래 코멘트에 추가적인 정보를 제공해 주신 것과 추가적인 코멘트에 대한 후속 조치로,

'Determine your product number
    'Open an xhr for your source url, and retrieve the product number from there - search for the tag which
    'text include the "productnummer:" substring, and extract the product number from the outerstring
    'OR
    'if the product number consistently consists of the fctkeywords you are entering in your source url
    'with two "0" appended - just build the product number like that
'Open an new xhr for this url "http://www.pfconcept.com/cgi-bin/wspd_pcdb_cgi.sh/y/y2productspec-ajax.p?itemc=" & product_number & "&_search=false&rows=-1&page=1&sidx=&sord=asc"
'Load the response in an XML document, and retrieve the material information

Sub getInfoWeb()

    Dim xhr As MSXML2.XMLHTTP60
    Dim doc As MSXML2.DOMDocument60
    Dim xmlCell As MSXML2.IXMLDOMElement
    Dim xmlCells As MSXML2.IXMLDOMNodeList
    Dim materialValueElement As MSXML2.IXMLDOMElement
    
    Set xhr = New MSXML2.XMLHTTP60
        
        With xhr
            
            .Open "GET", "http://www.pfconcept.com/cgi-bin/wspd_pcdb_cgi.sh/y/y2productspec-ajax.p?itemc=10031700&_search=false&rows=-1&page=1&sidx=&sord=asc", False
            .send
            
            If .readyState = 4 And .Status = 200 Then
                Set doc = New MSXML2.DOMDocument60
                doc.LoadXML .responseText
            Else
                MsgBox "Error" & vbNewLine & "Ready state: " & .readyState & _
                vbNewLine & "HTTP request status: " & .Status
            End If
            
        End With
        
        Set xmlCells = doc.getElementsByTagName("cell")

        For Each xmlCell In xmlCells
            If xmlCell.Text = "Materiaal" Then
                Set materialValueElement = xmlCell.NextSibling
            End If
        Next
        
        MsgBox materialValueElement.Text
    
End Sub

EDIT2: 대체 자동화 IE

Sub searchWebViaIE()
    Dim ie As SHDocVw.InternetExplorer
    Dim doc As MSHTML.HTMLDocument
    Dim anchors As MSHTML.IHTMLElementCollection
    Dim anchor As MSHTML.HTMLAnchorElement
    Dim prodSpec As MSHTML.HTMLAnchorElement
    Dim tableCells As MSHTML.IHTMLElementCollection
    Dim materialValueElement As MSHTML.HTMLTableCell
    Dim tableCell As MSHTML.HTMLTableCell
    
    Set ie = New SHDocVw.InternetExplorer
    
    With ie
        .navigate "http://www.pfconcept.com/cgi-bin/wspd_pcdb_cgi.sh/y/y2facetmain.p?fctkeywords=100317&world=general#tabs-4"
        .Visible = True
        
        Do While .readyState <> READYSTATE_COMPLETE Or .Busy = True
            DoEvents
        Loop
        
        Set doc = .document
        
        Set anchors = doc.getElementsByTagName("a")
        
        For Each anchor In anchors
            If InStr(anchor.innerHTML, "Product Specificatie") <> 0 Then
                anchor.Click
                Exit For
            End If
        Next anchor
        
        Do While .readyState <> READYSTATE_COMPLETE Or .Busy = True
            DoEvents
        Loop
    
    End With
        
    For Each anchor In anchors
        If InStr(anchor.innerHTML, "Product Specificatie") <> 0 Then
            Set prodSpec = anchor
        End If
    Next anchor
    
    Set tableCells = doc.getElementById("list-table").getElementsByTagName("td")
    
    If Not tableCells Is Nothing Then
        For Each tableCell In tableCells
            If tableCell.innerHTML = "Materiaal" Then
                Set materialValueElement = tableCell.NextSibling
            End If
        Next tableCell
    End If
    
    MsgBox materialValueElement.innerHTML
    
End Sub

테이블이나 엑셀(MS-Access 2013을 사용합니다)과는 관련이 없고 주제 제목과 직접 관련이 있습니다.나의 해결책은

Private Sub Sample(urlSource)
Dim httpRequest As New WinHttpRequest
Dim doc As MSHTML.HTMLDocument
Dim tags As MSHTML.IHTMLElementCollection
Dim tag As MSHTML.HTMLHtmlElement
httpRequest.Option(WinHttpRequestOption_UserAgentString) = "Mozilla/4.0 (compatible;MSIE 7.0; Windows NT 6.0)"
httpRequest.Open "GET", urlSource
httpRequest.send ' fetching webpage
Set doc = New MSHTML.HTMLDocument
doc.body.innerHTML = httpRequest.responseText
Set tags = doc.getElementsByTagName("a")
i = 1
For Each tag In tags
  Debug.Print i
  Debug.Print tag.href
  Debug.Print tag.innerText
  'Debug.Print tag.Attributes("any other attributes you need")() ' may return an object
  i = i + 1
  If i Mod 50 = 0 Then Stop
  ' or code to store results in a table
Next
End Sub

언급URL : https://stackoverflow.com/questions/25488687/parse-html-content-in-vba

반응형

'source' 카테고리의 다른 글

배열에서 요소의 모든 발생에 대한 인덱스를 찾는 방법은?  (0) 2023.10.26
쿼리를 밀리초 안에 실행하기 위해 인덱스를 향상시키는 방법은 무엇입니까?  (0) 2023.10.26
창을 표시하지 않고 파워셸 스크립트를 백그라운드 작업으로 실행하려면 어떻게 해야 합니까?  (0) 2023.10.26
XPath를 사용하여 텍스트 내용과 속성 값을 기반으로 노드를 선택하려면 어떻게 해야 합니까?  (0) 2023.10.26
소스 및 헤더 디렉토리가 별도인 Make 파일을 작성하는 방법?  (0) 2023.10.26

'source'의 다른글

  • 현재글VBA에서 HTML 컨텐츠 구문 분석

관련글

댓글

티스토리툴바