Question

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

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

这在我们的旧Windows 7（Office 2010）计算机上运行良好，但是我们中的一些人已经获得了新的Windows 10（Office 365）计算机。

代码运行时没有任何错误消息，但是当它到达时。它会直接跳转到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 Method (Outlook)

“首先，实例化Outlook Application对象，然后引用默认文件夹，例如收件箱。这会产生副作用，即初始化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 \

提示地址簿访问 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更改为您的办公版本）

将提示符更改为2（或询问系统管理员），重新启动Outlook，然后重试。

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

自Office 365升级以来，VBA中的MailItem.Send无法正常运行

2 个答案: