EXCEL VBA 自动发送邮件功能异常

Posted 2023-04-12

大家好，我是VBA菜鸟，我现在使用的一个宏用来自动发送邮件，但是每次发送到30个左右的订单时宏就提示出错，但是把前面已经发送的邮件清空，就可以重新发了，调试的结果是正文有问题，不知道咋回事，请高手指教，急！跪等！非常非常感谢！
调试出错界面

宏提示出错界面

发送界面

宏的代码如下：
Sub FASONG()Dim OutlookApp As ObjectDim MailItem As ObjectDim Recipient As ObjectDim i As IntegerDim h As IntegerRange("i2").Font.Size = 10
For i = 2 To Sheets(1).[B65536].End(xlUp).Row Set OutlookApp = CreateObject("Outlook.Application") Set MailItem = OutlookApp.CreateItem(0) If Cells(i, 1) <> "" Then MailItem.body = Cells(i, 11) ' content MailItem.Subject = Cells(i, 2) ' title MailItem.To = Cells(i, 10) 'send to address For h = 14 To 100 If Cells(i, h) <> "" Then MailItem.Attachments.Add Cells(i, h).Value End If Next MailItem.Send Set OutlookApp = Nothing Set MailItem = Nothing Set Recipient = Nothing End If NextEnd Sub

参考技术A Set OutlookApp = CreateObject("Outlook.Application") 挪到循环外面
Set MailItem = Nothing 挪到循环里面本回答被提问者采纳

Excel VBA：如何在 Outlook 中向组发送电子邮件？

【中文标题】Excel VBA：如何在 Outlook 中向组发送电子邮件？

【英文标题】：Excel VBA: How to send email to group in outlook?

【发布时间】：2017-01-09 11:13:46

【问题描述】：

我希望自动将电子邮件从 excel vba 发送到 Outlook 2013。

我可以将电子邮件发送给个人并通过 TITUS 分类，但是当我发送到群组电子邮件时仍然收到以下错误。

如何在 VBA 中选择“仍然发送”？

以下是我必须发送电子邮件的代码：

Dim AOMSOutlook As Object
Dim AOMailMsg As Object
Set AOMSOutlook = CreateObject("Outlook.Application")
Dim objUserProperty As Object
Dim OStrTITUS As String
Dim lStrInternal As String
Set AOMailMsg = AOMSOutlook.CreateItem(0)

Set objUserProperty = AOMailMsg.UserProperties.Add("TITUSAutomatedClassification", 1)
objUserProperty.Value = "TLPropertyRoot=ABCDE;Classification=Internal;Registered to:My Companies;"
With AOMailMsg
        .To = "[e-mail]"
        .Subject = "my subject"
        .Attachments.Add Img
        .HTMLBody = "my text"            
        .Save
        .Send
End With
Set AOMailMsg = Nothing
Set objUserProperty = Nothing
Set AOMSOutlook = Nothing
Set lOMailMsg = Nothing
Set objUserProperty = Nothing
Set lOMSOutlook = Nothing

非常感谢任何帮助！

【问题讨论】：

这看起来是 Outlook 中的策略设置，而不是编程问题。您可以使用 SendKey..

当您将其放在代码顶部时是否会弹出此窗口：Application.DisplayAlerts = False？您可以在代码底部将其设置回True。

@Chrismas007 我去看看 SendKey

@MattCremeens 我尝试将 DisplayAlerts 设置为 False 并将 EnableEvents 设置为 false，但警告框仍然出现在 Outlook 中

如果你还没有，也可以看看this

【参考方案1】：

感谢@MattCremeens 能够通过添加解决：

    .display
    SendKeys "DOWNDOWNENTER", True 'set classification
    SendKeys "ENTER",True 'send to group
    .send
End With