使用excel 2010 vba打开Outlook并发送电子邮件

时间:2016-01-25 15:44:58

标签: excel vba excel-vba

在下面的Excel 2010 vba中,如果Outlook已关闭,我正在尝试发送电子邮件。我确实收到了发送电子邮件但没有发送的确认信息。如果展望开放没有问题,但可能并非总是如此。谢谢 :)。

Option Explicit
Private Sub CommandButton21_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim oOutlook As Object

On Error Resume Next
Set oOutlook = GetObject(, "Outlook.Application")
On Error GoTo 0

If oOutlook Is Nothing Then
    Set oOutlook = CreateObject("Outlook.Application")
End If


strbody = "Hi xxxx," & vbNewLine & vbNewLine & _
          "There are 4 reports ready" & vbNewLine & _
          "Regards" & vbNewLine & vbNewLine & _
          "xxxxx xxxxx"

On Error Resume Next
With OutMail
    .To = "xxxxx@xxxxxxx.com"
    .CC = ""
    .BCC = ""
    .Subject = "data"
    .Body = strbody
    '.Attachments.Add ("C:\test.txt")
    .Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

' Confirm that the email(s) has/have been sent
    MsgBox "The data has been emailed sucessfully.", vbInformation

End Sub

2 个答案:

答案 0 :(得分:1)

以下代码打开outlook ...

Application.ActivateMicrosoftApp xlMicrosoftMail
Application.Wait(Now + TimeValue("00:00:03"))

答案 1 :(得分:0)

尝试不同的测试。 Err.Number很可能是429 ActiveX组件无法创建对象。

On Error Resume Next
Set oOutlook = GetObject(, "Outlook.Application")
On Error GoTo 0

If Err.Number <> 0 Then
    Set oOutlook = CreateObject("Outlook.Application")
End If

也许这个:

Set oOutlook = Nothing

On Error Resume Next
Set oOutlook = GetObject(, "Outlook.Application")
On Error GoTo 0

If oOutlook Is Nothing Then
    Set oOutlook = CreateObject("Outlook.Application")
End If