使用Excel 2010 vba打開Outlook並發送電子郵件

Question

在下面的excel 2010 vba如果Outlook已關閉，我嘗試發送電子郵件。 我確實收到電子郵件已發送但沒有任何發送的確認。 如果打開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

Answer 1

以下代碼將打開Outlook ...

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

Answer 2

嘗試其他測試。 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