MailItem.Send in VBA not functioning since Office 365 upgrade

问题

We send out a lot of spreadsheets around the organisation, in order to automate this as much as possible we wrote some code to send this automatically and allow us to still put body text in.

This particular Script picks information up from our Finance System (SAP) dumps it into Excel and emails it to the user, it loops through a number times downloading and emailing different data each time.

This works fine on our old windows 7 (Office 2010) machines but some of us have been given new Windows 10 (Office 365) machines to pilot.

The code runs without any error messages but when it gets to .Send it jumps straight to End Sub and does not send the email.

I have tried EmailItem.Display and you can see the email being populated and then just stays visible on the desktop as it loops through the rest of the emails.

Any ideas on how to get round this? I could use the application.send function but I like to have the ability to add custom text into the email body.

Thanks :)

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

回答1:

This describes how, in certain situations, you may "make the object model fully functional".

NameSpace.Logon Method (Outlook)

"first, instantiate the Outlook Application object, then reference a default folder such as the Inbox. This has the side effect of initializing MAPI to use the default profile and to make the object model fully functional."

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

回答2:

For security purposes, the HTMLBody, HTMLEditor, Body and WordEditor properties all are subject to address-information security prompts because the body of a message often contains the sender's or other people's e-mail addresses.

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

The most probable cause is Outlook Security.

You can find the security configurations in HKCU\Software\Policies\Microsoft\office\16.0\outlook\security
(change 16.0 to your office version)

Change promptoomsend to 2 (or ask your system administrator), restart Outlook and try again.

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

来源：https://stackoverflow.com/questions/50369434/mailitem-send-in-vba-not-functioning-since-office-365-upgrade

标签

excel

vba

outlook