自 Office 365 升级后，VBA 中的 MailItem.Send 不起作用

Question

我们在组织周围发送了大量电子表格，为了尽可能自动化，我们编写了一些代码来自动发送并允许我们仍然输入正文。

这个特定的脚本从我们的财务系统 (SAP) 中获取信息，将其转储到 Excel 中并通过电子邮件发送给用户，它会循环多次下载并每次通过电子邮件发送不同的数据。

这在我们的旧 Windows 7 (Office 2010) 机器上运行良好，但我们中的一些人已经获得了新的 Windows 10 (Office 365) 机器进行试验。

代码运行时没有任何错误消息，但是当它到达 .Send 时，它会直接跳转到 End Sub 并且不发送电子邮件。

我已经尝试过 EmailItem.Display，您可以看到正在填充的电子邮件，然后在它循环浏览其余电子邮件时只在桌面上保持可见。

关于如何解决这个问题的任何想法？ 我可以使用 application.send 函数，但我喜欢能够将自定义文本添加到电子邮件正文中。

谢谢 ：）

Sub EmailData()

Dim OL As Object
Dim EmailItem As Object
Dim y As Long
Dim TempChar As String
Dim Bodytext As String
Dim Flds As Variant
Dim EmailText As Range

Application.DisplayAlerts = False
Application.ScreenUpdating = False

'Email Download to nursery

Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.Createitem(OLMailItem)


'Check File Name is correct
Filename = Range("A1") & ".xls"
For y = 1 To Len(Filename)
    TempChar = Mid(Filename, y, 1)
    Select Case TempChar
    Case Is = "/", "\", "*", "?", """", "<", ">", "|"
    Case Else
        SaveName = SaveName & TempChar
    End Select
Next y
ActiveSheet.Cells.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlValues
Selection.PasteSpecial Paste:=xlFormats
With ActiveWindow
    .DisplayGridlines = False
    .DisplayZeros = False
End With
Range("A1:S38").Select
Selection.Locked = True
Selection.FormulaHidden = False
Set EmailText = ActiveSheet.Range("AB1:AB5").SpecialCells(xlCellTypeVisible)

ActiveSheet.Protect ("keepsafe")
ActiveWorkbook.SaveAs Networkpath & "\" & SaveName, , "", , True
ActiveWorkbook.ChangeFileAccess xlReadOnly


 EmailItem.display

'On Error Resume Next
With EmailItem
.To = "Daston@blahblah.uk"
'.To = Range("AA1")
.CC = ""
.BCC = ""
.Subject = Filename
.HTMLBody = RangetoHTML(EmailText)
.Attachments.Add ActiveWorkbook.FullName

.send
End With

Application.Wait (Now + TimeValue("0:00:02"))

Kill Networkpath & "\" & SaveName
ActiveWorkbook.Close False


Set OL = Nothing
Set EmailItem = Nothing

End Sub

Answer 1

这描述了在某些情况下如何“使对象模型完全发挥作用”。

NameSpace.Logon 方法 (Outlook)

“首先，实例化 Outlook 应用程序对象，然后引用一个默认文件夹，例如收件箱。这具有初始化 MAPI 以使用默认配置文件并使对象模型完全运行的副作用。”

Sub InitializeMAPI ()

    ' Start Outlook.
    Dim olApp As Outlook.Application
    Set olApp = CreateObject("Outlook.Application")

    ' Get a session object. 
    Dim olNs As Outlook.NameSpace
    Set olNs = olApp.GetNamespace("MAPI")

    ' Create an instance of the Inbox folder. 
    ' If Outlook is not already running, this has the side
    ' effect of initializing MAPI.
    Dim mailFolder As Outlook.Folder
    Set mailFolder = olNs.GetDefaultFolder(olFolderInbox)

    ' Continue to use the object model to automate Outlook.
End Sub

Answer 2

出于安全目的，HTMLBody、HTMLEditor、Body 和 WordEditor 属性都受地址信息安全提示的约束，因为邮件正文通常包含发件人或其他人的电子邮件地址。

HKCU\\Software\\Policies\\Microsoft\\office\\16.0\\outlook\\security\\

promptoomaddressbookaccess promptoomaddressinformationaccess

https://support.microsoft.com/en-za/help/926512/information-for-administrators-about-e-mail-security-settings-in-outlo

最可能的原因是 Outlook 安全。

您可以在 HKCU\\Software\\Policies\\Microsoft\\office\\16.0\\outlook\\security 中找到安全配置
（将 16.0 更改为您的办公版本）

将 promptoomsend 更改为 2（或询问您的系统管理员），重新启动 Outlook 并重试。

更多信息https://support.microsoft.com/en-za/help/926512/information-for-administrators-about-e-mail-security-settings-in-outlo