使用VBA解析不在標籤中的HTML文本

我需要獲取一些文本，但不包含任何HTML元素，除了在body標籤中，但問題在於文本被其他標籤打散並需要進入單獨的單元格。使用VBA解析不在標籤中的HTML文本

例如：

<a id="00:00:00" class="ts">[00:00:00]</a> <font class="mn">Name1</font> First bit of text<br/> 
<a id="00:00:09" class="ts">[00:00:09]</a> <font class="mn">Name2</font> Second Line of Text<br/> 
<a id="00:01:17" class="ts">[00:01:17]</a> <font class="mn">Name3</font> A third line of text<br/> 
<a id="00:01:59" class="ts">[00:01:59]</a> <font class="mn">Name4</font> The final line of text<br/>

我能夠獲得時間戳以及名稱爲各自列，但我無法弄清楚如何讓每行文本到相應的行。

這裏是我到目前爲止的代碼：

Dim i As Integer 
Dim Timestamp As Object 
Dim Name As Object 

my_url = "path_to_url.html" 
Set html_doc = CreateObject("htmlfile") 
Set xml_obj = CreateObject("MSXML2.XMLHTTP") 

xml_obj.Open "GET", my_url, False 
xml_obj.send 
html_doc.body.innerHTML = xml_obj.responseText 
Set xml_obj = Nothing 

Set Timestamp = html_doc.body.getElementsByTagName("a") 
Set Name = html_doc.body.getElementsByTagName("font") 

i = 2 
For Each itm In Timestamp 
    If itm.getAttribute("className") = "ts" Then 
     Cells(i, 1).Value = itm.innerText 
     i = i + 1 
    End If 
Next 

i = 2 
For Each itm In Name 
    If itm.getAttribute("className") = "mn" Then 
     Cells(i, 2).Value = itm.innerText 
     i = i + 1 
    End If 
Next

我想以某種方式使用也許和<br/>使用LEFT，但我不知道這是最好的辦法。提前致謝。

來源

2016-04-06 Alex S

是您在迴應中顯示的唯一內容的內容是？ –

感謝您的幫助添。使用你的代碼，我能夠在一行中添加註釋。但是，我遇到了一個意想不到的問題：HTML用作在線聊天記錄，因此儘管大多數條目處理正常，但我發現了一些情況，其中歸因於某人的文本被解讀爲「我將

複製到聊天中方框

和聊天記錄保留了所有換行符。「這是爲了讓你的代碼創建三個單獨的行而不是一個，將「進入聊天框」歸因於另一個用戶，等等。我現在正在研究某種錯誤。 –

看我的編輯如下 –

只要這是在響應中的唯一內容，並有你可以做這樣的事情沒有其它欄目

編輯：修改爲其他的東西分割比

Sub Tester() 

    Const RW_START As Long = 5 
    Const SPLITTER = "{xxxx}" 
    Dim i As Integer, html_doc, itm 
    Dim Timestamp As Object 
    Dim Name As Object 
    Dim arr, sep, txt 

    Set html_doc = CreateObject("htmlfile") 
    html_doc.body.innerHTML = Range("A1").Value 'for my testing... 


    Set Timestamp = html_doc.body.getElementsByTagName("a") 
    Set Name = html_doc.body.getElementsByTagName("font") 

    i = RW_START 
    For Each itm In Timestamp 
     If itm.getAttribute("className") = "ts" Then 
      Cells(i, 1).Value = itm.innerText 
      itm.innerText = "" '<<< 
      i = i + 1 
     End If 
    Next 

    i = RW_START 
    For Each itm In Name 
     If itm.getAttribute("className") = "mn" Then 
      Cells(i, 2).Value = itm.innerText 
      itm.innerText = IIf(i = RW_START, "", SPLITTER) '<<< 
      i = i + 1 
     End If 
    Next 

    'get the remaining text and split on newline (<br>) 
    arr = Split(html_doc.body.innerText, SPLITTER) 
    i = RW_START 
    For Each itm In arr 
     itm = Trim(itm) 
     'remove trailing vbLf 
     If Right(itm, 1) = vblf Then itm = Left(itm, Len(itm)-1) 
     Cells(i, 3).Value = Trim(itm) 
     i = i + 1 
    Next 

End Sub

來源

2016-04-06 22:45:23

使用VBA解析不在標籤中的HTML文本

回答

相關問題