Извлечение атрибута XML с помощью VBA

Question

Я не разработчик и не обладаю очень ограниченными знаниями XML, но за то, что узнал за последние 3-4 дня, исследуя в Интернете. Поэтому заранее извиняюсь за базовый уровень этого вопроса. Я пытаюсь завершить эту одноразовую задачу.

У меня есть знание VBA Excel, и в настоящее время я пытаюсь использовать VBA для извлечения атрибута кода SIC на странице данной компании на веб-сайте регистрации SEC. В качестве примера, это сайт для Walmart

http://www.sec.gov/cgi-bin/browse-edgar?action=getcompany&CIK=0000104169&owner=exclude&count=40&hidefilings=0

В синей строке в верхней части можно увидеть «SIC: 5331» это 5331 я пытаюсь вернуться к переменной VBA, так что я могу заполнить таблицу. Когда я правая кнопка мыши в IE и клише View Source часть страницы, которая имеет отношение читает в XML как:

<div id="contentDiv"> 
    <!-- START FILER DIV --> 
    <div style="margin: 15px 0 10px 0; padding: 3px; overflow: hidden; background-color: #BCD6F8;"> 
    <div class="mailer">Mailing Address 
     <span class="mailerAddress">702 SOUTHWEST 8TH STREET</span> 
     <span class="mailerAddress"> BENTONVILLE AR 72716   </span> 
    </div> 
    <div class="mailer">Business Address 
     <span class="mailerAddress">702 SOUTHWEST 8TH ST</span> 
     <span class="mailerAddress">BENTONVILLE AR 72716   </span> 
     <span class="mailerAddress">5012734000</span> 
    </div> 
    <div class="companyInfo"> 
     <span class="companyName">WAL MART STORES INC <acronym title="Central Index Key">CIK</acronym>#: <a href="/cgi-bin/browse-edgar?action=getcompany&amp;CIK=0000104169&amp;owner=exclude&amp;count=40">0000104169 (see all company filings)</a></span> 
     <p class="identInfo"><acronym title="Standard Industrial Code">SIC</acronym>: <a href="/cgi-bin/browse-edgar?action=getcompany&amp;SIC=5331&amp;owner=exclude&amp;count=40">5331</a> - RETAIL-VARIETY STORES<br />State location: <a href="/cgi-bin/browse-edgar?action=getcompany&amp;State=AR&amp;owner=exclude&amp;count=40">AR</a> | State of Inc.: <strong>DE</strong> | Fiscal Year End: 0131<br />(Assistant Director Office: 2)<br />Get <a href="/cgi-bin/own-disp?action=getissuer&amp;CIK=0000104169"><b>insider transactions</b></a> for this <b> issuer</b>. 
     <br />Get <a href="/cgi-bin/own-disp?action=getowner&amp;CIK=0000104169"><b>insider transactions</b></a> for this <b>reporting owner</b>. 
     </p> 
    </div> 
    </div> 
</div> 

Пытаясь понять, как VBA может быть использован для извлечения SIC, я обнаружил следующее сообщение на ваш сайт:

Query and parse xml attribute value into XLS using VBA

Я попытался применить ответ barrowc путем копирования/вставки в модуль Excel и вставить путь к опилками Wal Mart, однако, когда я пошагово я получаю Debug.Print «*** ** «но я ничего не получаю для n.Text.

Sub test4() 
    Dim d As MSXML2.DOMDocument60 
    Dim i As IXMLDOMNodeList 
    Dim n As IXMLDOMNode 

    Set d = New MSXML2.DOMDocument60 
    d.async = False 
    d.Load ("http://www.sec.gov/cgi-bin/browse-edgar?company=&match=&CIK=886475&filenum=&State=&Country=&SIC=&owner=exclude&Find=Find+Companies&action=getcompany") 

    Debug.Print "*****" 
    Set i = d.SelectNodes("//div[@id='contentDiv']") 
    For Each n In i 
     Debug.Print n.Text 
    Next n 
    Debug.Print "*****" 

    Set d = Nothing 
End Sub 

Я пробовал различные строки в d.SelectNodes(), но я не знаю достаточно об этой теме, чтобы понять, где я буду неправильно не знаю. Таким образом, комментарий к моему синтаксису или указатель на ресурс был бы чрезвычайно полезен.

Answer 1

Если вас интересует только SIC, не стоит тратить время на анализ всей структуры DOM. Вместо этого определите уникальный набор символов, найдите это, а затем извлеките из него SIC.

Следующая функция делает именно это. Вам просто нужно передать его полный исходный HTML-страницы, и она будет возвращать SIC:

Function ExtractSIC(SourceHtml As String) As String 
    Const PrefixChars As String = "&SIC=" 
    Const SuffixChars As String = "&" 
    Dim StartPos As Long, EndPos As Long 
    StartPos = InStr(SourceHtml, PrefixChars) 
    If StartPos = 0 Then Exit Function 

    StartPos = StartPos + Len(PrefixChars) 
    EndPos = InStr(StartPos, SourceHtml, SuffixChars) - 1 
    ExtractSIC = Mid(SourceHtml, StartPos, EndPos - StartPos + 1) 
End Function 

Answer 2

Еще раз спасибо mwolfe. Я разместил свой код ниже, но то, что вы предоставили, намного элегантнее. Я знаю, что SIC - всего 4 цифры, поэтому я ленился и сделал это предположение в коде, и это может вызвать ошибки в будущем. Вы можете видеть, как я это сделал в комментариях.

Sub GetSICs() 
    Application.ScreenUpdating = False 

    Dim AWBN As String 
    Dim ASN As String 
    Dim CIK As String 
    Dim NUM_FILES_TO_GET As Long 
    Dim COUNTER As Long 
    Dim SICTagPos As Integer 
    Dim SIC As String 

    Set IEbrowser = CreateObject("InternetExplorer.application") 
    IEbrowser.Visible = False 
    AWBN = ActiveWorkbook.Name 
    ASN = ActiveSheet.Name 
    Workbooks(AWBN).Sheets(ASN).Range("A1").Select 
    ActiveCell.Offset(0, 11) = "SIC" 
    NUM_FILES_TO_GET = Application.WorksheetFunction.CountA(Range("A:A")) 
    For COUNTER = 1 To 3 'NUM_FILES_TO_GET 
     Application.StatusBar = "Counter = " & COUNTER 
     'SICTagPos = 0 
     CIK = ActiveCell.Offset(COUNTER, 2) 
     IEbrowser.Navigate URL:="http://www.sec.gov/edgar/searchedgar/companysearch.html" 
     Do 
      DoEvents 
     Loop Until IEbrowser.readyState = 4 
     Set frm = IEbrowser.Document.forms(0) 
     frm("CIK").Value = CIK 
     frm.submit 
     While IEbrowser.Busy Or IEbrowser.readyState <> 4: DoEvents: Wend 
     SIC = ExtractSIC(IEbrowser.Document.body.innerhtml) 
     'SICTagPos = InStr(1, IEbrowser.Document.body.innerhtml, "SIC=") 
     'SIC = Right(Left(IEbrowser.Document.body.innerhtml, SICTagPos + 7), 4) 
     ActiveCell.Offset(COUNTER, 11).NumberFormat = "@" 
     ActiveCell.Offset(COUNTER, 11) = SIC 

    Next 

    Application.StatusBar = False 
    Application.ScreenUpdating = True 

End Sub 


Function ExtractSIC(SourceHtml As String) As String 
    Const PrefixChars As String = "&amp;SIC=" 
    Const SuffixChars As String = "&" 
    Dim StartPos As Long, EndPos As Long 
    StartPos = InStr(SourceHtml, PrefixChars) 
    If StartPos = 0 Then Exit Function 

    StartPos = StartPos + Len(PrefixChars) 
    EndPos = InStr(StartPos, SourceHtml, SuffixChars) - 1 
    ExtractSIC = Mid(SourceHtml, StartPos, EndPos - StartPos + 1) 
End Function