如何把word2013作为正文加入到outlook2013邮件

Question

如题所述

Answer 1

你好
​通过调用 word的宏倒可以曲线实现这样的功能
胡乱凑出来的代码 不过调试以已经通过 分享给大家 ，不要贻笑大方哦

Public wdApp As Word.Application
Public wdAppTem As Word.Application
Public Mail_Doc As String
Public Mail_Text
Public Mail_Counter As Integer
Public ReportDate_Temp As Date
Public Sent_Date As String
Public Sent_Date_Temp As String
Public Report_Flag As String
Public Report_Subject As String

Public Sub Open_Word_OutLook()
.......

Work_Path = ThisWorkbook.Path
Mail_Doc = Work_Path & "\" & "Mailok.doc"

Set wdApp = New Word.Application
With wdApp
.Documents.Open Filename:=Mail_Doc
.Visible = True
.ActiveWindow.EnvelopeVisible = False
End With

'打开word 编辑word

wdApp.Selection.WholeStory
wdApp.Selection.Delete

'#####################################################################################

For Mail_Counter = 1 To 18

Mail_Text = ThisWorkbook.Sheets("Mail").Range("A" & Mail_Counter).Value

With wdApp
.Documents.Open Filename:=Mail_Doc
.Visible = True
With .Selection
.EndKey unit:=wdStory
.Text = Mail_Text
.EndKey unit:=wdLine
.TypeParagraph
End With
End With

Next Mail_Counter

'Finish Item 1 to 5

'#####################################################################################

Sheets("Report").Select
ThisWorkbook.Sheets("Report").Range(Cells(39, 1), Cells(51, 6)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Pictures.Paste.Select
Application.CutCopyMode = False
Selection.Cut

With wdApp
With .Selection
.EndKey unit:=wdStory
.Paste
.EndKey unit:=wdLine
.TypeParagraph
.TypeParagraph
End With
End With
'Finish Paste Equipment Status PIC

'#####################################################################################

Sheets("Mail").Select

Mail_Text = ThisWorkbook.Sheets("Mail").Range("A19").Value

With wdApp
With .Selection
.EndKey unit:=wdStory
.Text = Mail_Text
.EndKey unit:=wdLine
.TypeParagraph
.TypeParagraph
End With
End With

'Finish paste "ATE down Time & HST Availability"

Sheets("Report").Select
ThisWorkbook.Sheets("Report").Range(Cells(15, 1), Cells(21, 4)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Pictures.Paste.Select
Application.CutCopyMode = False
Selection.Cut

With wdApp
With .Selection
.EndKey unit:=wdStory
.Paste
.EndKey unit:=wdLine
.TypeParagraph
.TypeParagraph
End With
End With

'Finish Paste ATE down Time & HST Availability PIC

...........
...........
...........

Sheets("Mail").Select
ActiveSheet.Shapes("Picture 1").Select

Application.CutCopyMode = False
Selection.Copy

With wdApp
With .Selection
.EndKey unit:=wdStory
.Paste
.EndKey unit:=wdLine
End With
End With

'#####################################################################################

With wdApp
.ActiveDocument.Save
End With

'编辑word 结束

wdApp.Run "Create_Mail"

'调用word 宏 将正文创建邮件 至于标题收件人之类在word vba 中完成

AppActivate "Microsoft word"

Do Until wdApp.ActiveWindow.EnvelopeVisible = False
On Error GoTo 1
Loop

With wdApp
' .ActiveDocument.Close
.Quit
End With

Set wdApp = Nothing
GoTo 3

1: Set wdApp = Nothing
GoTo 2

2: MsgBox "You have not sent the mail!!!" & Chr(10) & "The Word Appliction have not close correctly!!!"

3: Sheets("Report").Select

End Sub