运行时错误'2147467259(80004005)'从VBA代码发送电子邮件

时间:2018-09-24 17:12:28

标签: vba email ms-access outlook

我正在尝试通过我的VB代码发送文件电子邮件。我有一个链接表,其中包含电子邮件地址,但出现运行时错误'-2147467259(80004005)'我们需要知道将其发送给谁。确保输入至少一个名字”

Public Function sendmail(mailSub As String, mailTo As String, _
       Optional msgBody As String, Optional mailCC As String, _
       Optional mailBCC As String, Optional mailFrom As String, _
                                Optional pathToAttach As String) As Boolean

Dim oApp As Object, oMail As Object, oAttach As Object
sendmail = False

Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0) 'olMailItem=0
Set oAttach = oMail.Attachments
With oMail
    .BodyFormat = 2 'olFormatHTML=2, olFormatPlain=1, olFormatRichText=3
    .SentOnBehalfOfName = mailFrom
    .To = mailTo
    .CC = mailCC
    .BCC = mailBCC
    .Subject = mailSub
    .htmlBody = msgBody & "<BR>" & .htmlBody
    .Recipients.ResolveAll
End With
If pathToAttach & "" <> "" Then oAttach.Add pathToAttach,  olByValue, 1
oMail.Send   '<<This is where I am getting the error
oMail.Display

sendmail = True
Exit Function


End Function

Public Function getEmails(Address_type As String) As String
    Dim rst As Recordset, tbl_Email As String
    tbl_Email = "tbl_Email" ' Change this as needed
    On Error GoTo no_rec
    Set rst = CurrentDb.OpenRecordset("SELECT * FROM " & tbl_Email & " WHERE " & _
                                   Address_type & "=TRUE")
    rst.MoveLast
    rst.MoveFirst

    While Not rst.EOF
        getEmails = getEmails & rst![Email] & ";"
        rst.MoveNext
    Wend
no_rec:
    If Not rst Is Nothing Then rst.Close
    Set rst = Nothing
End Function

1 个答案:

答案 0 :(得分:0)

首先,没有理由同时调用 发送和显示:如果您正在显示消息,则不应调用发送-用户将单击“发送”按钮

如果用保存替换发送呼叫,在显示给用户的消息中您是否看到收件人?

相关问题