如何使用VBA将HTML插入Word？

Question

我正在尝试抓取一个特定HTML元素的网站，并将其转换为Word，同时保持格式完整。我可以先成功将其导入Excel（然后再导入到Word），但单个单元格的字符限制不能让我获取所需的所有数据。这是我当前的代码，从我从网站上获取HTML开始：

Set html = ie.document

Dim objWord As Object
   Dim objDoc As Object
   Set objWord = CreateObject("Word.Application")
   Set objDoc = objWord.Documents.Add
   objWord.Visible = True

Sheets("Sheet1").Range("A1").Value = html.getElementById("main_container").innerText
Sheets("Sheet1").Range("A1").Select
Selection.Copy

objDoc.Range.Paste

如果我可以跳过Excel步骤并将HTML粘贴到Word中，那将是很棒的。我想到的另一个选项是将main_container HMTL的每个子段粘贴到一个单独的单元格中，以避免达到最大字符限制。如果有人可以提供帮助，或者对我如何解决这个问题有其他想法，我们将不胜感激！

在这里交叉发布：http://www.mrexcel.com/forum/excel-questions/827926-hmtl-word-visual-basic-applications.html#post4039337

Answer 1

请改用字符串变量！

Dim sInnerText As String, i As Integer, j As Integer

sInnerText = html.getElementById("main_container").innerText

'insert text into word document
objDoc.Range.Text = sInnerText

'or devide it by length of characters to be able to add parts into cells
i = 1
j = 1
Do While j<Len(sInnerText)
    ThisWorkbook.Worksheets("Sheet1").Range("A" & i) = Mid(sInnerText, j, j+255)
    j = j + 256
    i = i + 1
Loop

Answer 2

也许你正在寻找这样的东西。我使用这两个程序使用WildCards设置sub和superscript html标签并撤消

Sub SuperSub()
'Sub y Super Indices a formato HTML
        With ActiveDocument.Content.Find
                .Text = "" 'Subíndice
                .Font.Subscript = 1
                .Replacement.Text = "<sub>^&</sub>"
                .Replacement.Font.Subscript = 0
                .Execute Replace:=wdReplaceAll
        End With
        With ActiveDocument.Content.Find
                .Text = "" 'Superíndice
                .Font.Superscript = 1
                .Replacement.Text = "<sup>^&</sup>"
                .Replacement.Font.Superscript = 0
                .Execute Replace:=wdReplaceAll
        End With
End Sub
Sub InverSuperSub()
'Sub y Super Indices de html a WORD
        With ActiveDocument.Content.Find
                .Text = "\<sub\>(*)\<\/sub\>" 'Subíndice
                .MatchWildcards = True
                .Font.Subscript = 0
                .Replacement.Text = "\1"
                .Replacement.Font.Subscript = 1
                .Execute Replace:=wdReplaceAll
        End With
        With ActiveDocument.Content.Find
                .Text = "\<sup\>(*)\<\/sup\>" 'Superíndice
                .MatchWildcards = True
                .Font.Superscript = 0
                .Replacement.Text = "\1"
                .Replacement.Font.Superscript = 1
                .Execute Replace:=wdReplaceAll
        End With
End Sub

我希望它能帮到你。