Excel 基于值将Word中的文本插入邮件

Excel 基于值将Word中的文本插入邮件,excel,vba,ms-word,Excel,Vba,Ms Word,我有一个Excel工作表,有很多行。基于一列中的值,我想将word文档中的文本插入电子邮件 我尝试使用复制/粘贴,但无法从粘贴功能获取数据。保留格式对我来说很重要 有解决办法吗 Dim Outlook_App As Object Dim Outlook_Mail As Object Dim wordapp As Object Dim IntKalkLinieNr As Integer Dim VarRetVal As Variant Dim StrFilnavn As String Dim

我有一个Excel工作表,有很多行。基于一列中的值,我想将word文档中的文本插入电子邮件

我尝试使用复制/粘贴,但无法从粘贴功能获取数据。保留格式对我来说很重要

有解决办法吗

Dim Outlook_App As Object
Dim Outlook_Mail As Object


Dim wordapp As Object
Dim IntKalkLinieNr As Integer
Dim VarRetVal As Variant
Dim StrFilnavn As String

Dim OutApp As Object
Dim OutMail As Object

Set clipboard = New MSForms.DataObject

IntKalkLinieNr = 16
StrFilnavn = CStr(Worksheets("Kalkulation").Range("X" & CStr(IntKalkLinieNr)).Value)

Set wordapp = CreateObject("word.Application")
wordapp.Visible = True
Set WordDoc = wordapp.Documents.Add
wordapp.CommandBars("Navigation").Visible = False
wordapp.Selection.Find.ClearFormatting

wordapp.Selection.InsertFile Filename:=StrFilnavn, ConfirmConversions:=False, Link:=False, Attachment:=False
wordapp.Selection.WholeStory
wordapp.Selection.Copy


Set Outlook_App = CreateObject("Outlook.Application")
Set Outlook_Mail = Outlook_App.CreateItem(0)
'    On Error Resume Next
With Outlook_Mail
    .To = "ln@unik.dk"
    .Subject = "Tilbud"
    .Body = wordapp.Selection.Paste
    .Display
End With


WordDoc.Close SaveChange:=wdDoNotSaveChanges
Word.Quit