使用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文本

回答

相关问题