使用VBA提取XML屬性

Question

我不是一名開發人員，擁有非常有限的XML知識，但是我學到了過去3 - 4天在Web上進行的研究。所以提前對這個問題的基本層面表示歉意。我正試圖結束這一次的任務。

我有一些VBA Excel知識，目前我正嘗試使用VBA從SEC文件網站上的給定公司頁面提取SIC代碼屬性。作爲一個例子，這是網站沃爾瑪

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

在你可以看到頂部的藍色條「SIC：5331」這是在5331我試圖返回到VBA變量，這樣我可以填充電子表格。當我在IE和陳詞濫調查看源文件右鍵單擊頁面的一部分是相關的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工作模塊插入路徑沃爾瑪申請但是當我步我得到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