我正在尝试在VBA Excel中自动发送电子邮件,但是没有任何发送。如果我从。发送更改为。显示,则会显示正确的电子邮件和正确填写的电子邮件。
我正在使用的代码是
Sub SendEmail()
Dim errorMsg As String
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error GoTo errHandle
With OutMail
.To = "user@email.com"
'.cc = cc
'.bcc = er.emailBcc
.subject = "test"
.htmlBody = "test body"
.Send 'or use .Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
SendEmailWithOutlook = True
errHandle:
errorMsg = "Error sending mail via outlook: " & Err.Description & vbCrLf
MsgBox errorMsg
SendEmailWithOutlook = False
End Sub
我收到以下错误
通过Outlook发送邮件时出错:应用程序定义或对象定义 错误。
我还有其他需要工作的地方并发送邮件吗? (如果我从.send更改为.display,则可以使用。
答案 0 :(得分:0)
尝试一下,至少添加 Microsoft Outlook X.0对象库,要添加该库,请遵循以下过程工具->参考->选择Microsoft Outlook X库.0对象库->按OK:
Sub SendMail(ByVal Sujet As String, ByVal Destinataire As String, ByVal ContenuEmail As String, Optional ByVal PieceJointe As String)
' Add Microsoft Outlook X.0 Object Library to make the macro work
On Error GoTo EnvoyerEmailErreur
Dim oOutlook As Outlook.Application
Dim WasOutlookOpen As Boolean
Dim oMailItem As Outlook.MailItem
Dim Body As Variant
Dim Destinataire As String
Dim Sujet As String
Dim Body As String
Destinataire = "Test@test.com"
Sujet = "Choose a subject"
Body = "Your email"
If (Body = False) Then
MsgBox "Mail non envoyé car vide", vbOKOnly, "Message"
Exit Sub
End If
PreparerOutlook oOutlook
Set oMailItem = oOutlook.CreateItem(0)
With oMailItem
.To = Destinataire
.Subject = Sujet
.BodyFormat = olFormatHTML
.HTMLBody = "<html><p>" & Body & "</p></html>"
.Display
'.Save
.Send
End With
If (Not (oMailItem Is Nothing)) Then Set oMailItem = Nothing
If (Not (oOutlook Is Nothing)) Then Set oOutlook = Nothing
Exit Sub
EnvoyerEmailErreur:
If (Not (oMailItem Is Nothing)) Then Set oMailItem = Nothing
If (Not (oOutlook Is Nothing)) Then Set oOutlook = Nothing
MsgBox "Le mail n'a pas pu être envoyé...", vbCritical, "Erreur"
End Sub
Private Sub PreparerOutlook(ByRef oOutlook As Object)
On Error GoTo PreparerOutlookErreur
On Error Resume Next
'vérification si Outlook est ouvert
Set oOutlook = GetObject(, "Outlook.Application")
If (Err.Number <> 0) Then 'si Outlook n'est pas ouvert, une instance est ouverte
Err.Clear
Set oOutlook = CreateObject("Outlook.Application")
Else 'si Outlook est ouvert, l'instance existante est utilisée
Set oOutlook = GetObject("Outlook.Application")
oOutlook.Visible = True
End If
Exit Sub
PreparerOutlookErreur:
MsgBox "Une erreur est survenue lors de l'exécution de PreparerOutlook()..."
End Sub
最诚挚的问候