粘贴Outlook电子邮件中的单元格内容,保持格式

时间:2015-11-11 14:54:16

标签: excel vba email outlook

我创建了一个在Outlook中创建电子邮件草稿的过程。用户可以通过将其写入范围来修改电子邮件正文,并将其添加到电子邮件中,并保留所有格式选项。

我的问题是,当我的程序首先工作时,当我开始使用单词编辑器Microsoft Outlook开始崩溃时,消息" Microsoft Outlook已停止运行"当我杀死Outlook时,我收到消息"远程程序失败"在VBA上

为什么会发生这种情况?有没有办法在运行代码之前打开Outlook以避免错误?

Public Sub CreateDraft(Destinatary As String, CC As String, Subject As String, Body As Range, Optional AttachmentPath As String = "")
    Dim OutApp  As Object
    Dim OutMail As Object
    Dim WordDoc As Word.Document
    Dim WordRange As Word.Range
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .Display
        .To = Destinatary
        .CC = CC
        .Subject = Subject
        Set WordDoc = OutApp.ActiveInspector.WordEditor
        Set WordRange = WordDoc.Goto(What:=wdGoToSection, Which:=wdGoToFirst) ' The code crashes here
        Body.Copy
        WordRange.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
        .HTMLBody = .HTMLBody
        If (AttachmentPath <> "") Then
            .Attachments.Add (AttachmentPath)
        End If
        .Save
        .Close (False)
    End With
    Application.CutCopyMode = False
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

2 个答案:

答案 0 :(得分:0)

问题不在于Outlook没有运行,而是当您以编程方式打开Outlook时,它处于与用户打开应用程序时不同的状态。诸如Word Editor之类的东西无法正常工作。您可以通过单步执行代码来验证这一点,并且您应该看到在创建Outlook.Application对象后,Outlook图标位于系统托盘中,其工具提示将说明另一个程序正在控制Outlook。

我的建议是确定Outlook何时处于此状态,然后通知您的用户在执行代码之前需要确保Outlook正在运行。确定用户是否已打开的一种方法是查看Explorers对象。当用户打开Outlook时,总会有至少1个,如果没有,则可以在再次尝试之前提示用户对其执行某些操作。

Dim oApp As Outlook.Application

'   Open / Connect with Outlook
Set oApp = CreateObject("Outlook.Application")

'   Check Outlook has been opened by a user
While oApp.Explorers.Count = 0

    If Not MsgBox("Please open Outlook and click Retry to try again.", vbExclamation + vbRetryCancel, "Outlook Not Open") = vbRetry Then

        Exit Sub
    End If

Wend

' Outlook has been opened by the user
' Continue.....

答案 1 :(得分:0)

This is the only thing that worked. I defined OutApp and OutMail as Outlook objects and then got the inspector from the OutMail object. Using the .GetInspector method.

Public Sub CreateDraft(Destinatary As String, CC As String, Subject As String, Body As Range, Field1 As String, Field2 As String, Field3 As String, Optional AttachmentPath As String = "")
    Dim OutApp As New Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim OutInspector As Outlook.Inspector
    Dim WordDoc As Word.Document
    Dim WordRange As Word.Range
    Set OutMail = OutApp.CreateItem(olMailItem)
    With OutMail
        .To = Destinatary
        .CC = CC
        .Subject = Subject
        If AttachmentPath <> "" Then .Attachments.Add (AttachmentPath)
        .Display
        Set OutInspector = OutMail.GetInspector
        Set WordDoc = OutInspector.WordEditor
        If Not (WordDoc Is Nothing) Then
            Set WordRange = WordDoc.Range(0, 0)
            Call Body.Copy
            Call WordRange.PasteExcelTable(LinkedToExcel:=False, WordFormatting:=False, RTF:=False)
            Application.CutCopyMode = False
        End If
        Call .Save
        Call .Close(False)
    End With
End Sub