VBA从嵌入式Word文档复制内容并保留格式

时间:2015-04-15 21:58:56

标签: excel vba excel-vba

我将Excel 2010与嵌入式Word文档结合使用。 Word文档基本上是一个具有一些格式(粗体/下划线/超链接)的通信模板。

流程:用户打开Excel文档,为Excel提供输入,并完成模板。 Excel中的输入与模板的内容之间没有交互。

我正在尝试构建此流程,以便在他们编辑embedded Word Document后,用户点击button。然后,VBA代码将获取embedded Word document的内容并粘贴(格式化全部)作为电子邮件的正文。该文件会将自己附加到该电子邮件中,然后将其用于批准。

我已经能够找到代码让我参与其中的一部分,并提供道具到期的道具,我找到代码here(参见下面的代码)

但是这并没有保留Word文档的格式。有什么建议?也许如果我可以将Word内容提取为可行的HTML。但不知道该怎么做。所有帮助表示赞赏。

Sub Test()
  Dim Oo As OLEObject
  Dim wDoc As Object 'Word.Document

  'Search for the embedded Word document
  For Each Oo In Sheet8.OLEObjects
    If InStr(1, Oo.progID, "Word.Document", vbTextCompare) > 0 Then
        'Open the embedded document
        Oo.Verb xlVerbPrimary
        'Get the document inside
        Set wDoc = Oo.Object

        'Copy the contents to cell A1
        wDoc.Content.Copy
        With Sheet8.Range("M1")
            .PasteSpecial xlPasteFormats
            .PasteSpecial xlPasteValues
        End With


        'Select any cell to close the document
        Sheet8.Range("M1").Select
        'Done
      Exit For
    End If
  Next
  Set wDoc = Nothing
End Sub

在审核了共产国际代码之后,我遇到了一个我无法解决的错误。我回到了电路板并找到了一些额外的代码。合并两者似乎已经解决了。

Sub HTMLExport()
Dim objOnSheet As oleObject
Dim strFileName As String
Dim sh As Shape
Dim objWord As Object ''Word.Document
Dim objOLE As oleObject

Sheet8.Activate
Set sh = ActiveSheet.Shapes("RA_Template")
sh.OLEFormat.Activate
Set objOLE = sh.OLEFormat.Object
Set objWord = objOLE.Object

ActiveSheet.Range("M1").Activate

''Easy enough
strFileName = CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\temp.html"
objWord.SaveAs2 Filename:=strFileName, FileFormat:=10  '10=wdFormatFilteredHTML


'Copy the file contents into cell M1...
Dim handle As Integer
    handle = FreeFile
    Open strFileName For Input As handle
    Sheet8.Range("M1").Value = Input$(LOF(handle), handle)
    Close handle

'Delete the Temp File (strFileName)
Kill strFileName

'Select any cell to close the document
Sheet8.Range("M1").Select

结束Sub`

1 个答案:

答案 0 :(得分:0)

如果将它转换为HTML将会起作用(Word会让HTML变得非常丑陋......),您只需将其保存到临时文件中然后重新选择它:

Sub HTMLExport()
    Dim Oo As OLEObject

    'Search for the embedded Word document
    For Each Oo In Sheet8.OLEObjects
        If InStr(1, Oo.progID, "Word.Document", vbTextCompare) > 0 Then
            Dim temp As String
            'GetSpecialFolder(2) gives the user's temp folder.
            temp = CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\temp.html"
            '10 = wdFormatFilteredHTML
            Oo.Object.SaveAs2 temp, 10

            'Copy the file contents into cell M1...
            Dim handle As Integer
            handle = FreeFile
            Open temp For Input As handle
            Sheet8.Range("M1").Value = Input$(LOF(handle), handle)
            Close handle
            '...and delete the temp file.
            Kill temp

            'Select any cell to close the document
            Sheet8.Range("M1").Select
            'Done
            Exit For
        End If
    Next
End Sub

请注意,如果您使用此方法,则在获取OLEObject后无法打开嵌入的Word文档,或者Word将不允许您保存它。