MailItem.GetInspector.WordEditor в Office 2016 генерирует ошибку, определяемую приложением или объектом

Убедитесь, что Word является редактором электронной почты по умолчанию. Из Dox Inspector.WordEditor:

Свойство WordEditor допустимо только в том случае, если метод IsWordMail возвращает True, а свойство EditorType равно olEditorWord. Возвращенный объект WordDocument обеспечивает доступ к большей части объектной модели Word ...

Кроме того, убедитесь, что Outlook настроен для отправки электронных писем в формате RTF или HTML, а не в виде обычного текста.

Я не совсем уверен, была ли у меня та же проблема, что и у вас, но после обновления Office 2016 у меня начались сбои при обращении к GetInspector. Чтобы быть ясным, он работал с Office 2016, а затем перестал работать после последнего обновления.

Следующее обходное решение сработало для меня

dim item : set item = Addin.Outlook.CreateItemFromTemplate(Filename)
Outlook.Inspectors.Add(item) ' Outlook is the application object

Кажется, что он работает, только если я добавляю элемент сразу после его создания, устанавливая для него свойства, а затем добавляя его, не сработало.

Примечание: я не тестировал с CreateItem вместо CreateItemFromTemplate. Вторая строка была добавлена ​​и не нужна до обновления Office.

Попробуйте переместить редактор к первому действию ... ...

     With OutMail

        Set outEdit = .GetInspector.WordEditor
        outEdit.Content.Paste

        .SendUsingAccount = OutApp.Session.Accounts.Item(1)
        .To = sendEmail
        .CC = ccEmail
        .Subject = subjEmail & " (Site: " & siteName & ")"

...

Проблема: В целях безопасности свойства HTMLBody, HTMLEditor, Body и WordEditor являются предметом запросов безопасности информации об адресе, поскольку тело сообщения часто содержит адреса электронной почты отправителя или других людей. И, если групповая политика не разрешает, эти запросы не появляются на экране. Проще говоря, как разработчик вы обязаны изменить свой код, потому что нельзя вносить изменения в реестр и изменять групповую политику.

Следовательно, если ваш код внезапно перестал работать после перехода на Office 365 или по каким-либо другим причинам, обратитесь к приведенным ниже решениям. Комментарии были добавлены для облегчения понимания и реализации.

Решение 1. Если у вас есть права администратора, попробуйте внести изменения в реестр по ссылке ниже: https://support.microsoft.com/en-au/help/926512/information-for-administrators-about-e-mail-security-settings-in-outlo

Однако, как разработчик, я рекомендую код, который достаточно совместим со всеми версиями Excel, вместо того, чтобы вносить изменения в систему, потому что системные изменения потребуются также на каждом компьютере конечного пользователя.

Решение 2. Совместимость с кодом VBA: Excel 2003, Excel 2007, Excel 2010, Excel 2013, Excel 2016, Office 365.

Option Explicit

Sub Create_Email(ByVal strTo As String, ByVal strSubject As String)


    Dim rngToPicture As Range
    Dim outlookApp As Object
    Dim Outmail As Object
    Dim strTempFilePath As String
    Dim strTempFileName As String

    'Name it anything, doesn't matter
    strTempFileName = "RangeAsPNG"

    'rngToPicture is defined as NAMED RANGE in the workbook, do modify this name before use
    Set rngToPicture = Range("rngToPicture")
    Set outlookApp = CreateObject("Outlook.Application")
    Set Outmail = outlookApp.CreateItem(olMailItem)

    'Create an email
    With Outmail
        .To = strTo
        .Subject = strSubject

        'Create the range as a PNG file and store it in temp folder
        Call createPNG(rngToPicture, strTempFileName)

        'Embed the image in Outlook
        strTempFilePath = Environ$("temp") & "\" & strTempFileName & ".png"
        .Attachments.Add strTempFilePath, olByValue, 0

        'Change the HTML below to add Header (Dear John) or signature (Kind Regards) using newline tag (<br />)
        .HTMLBody = "<img src='cid:DashboardFile.png' style='border:0'>"


        .Display

    End With

    Set Outmail = Nothing
    Set outlookApp = Nothing
    Set rngToPicture = Nothing

End Sub

Sub createPNG(ByRef rngToPicture As Range, nameFile As String)

    Dim wksName As String

    wksName = rngToPicture.Parent.Name

    'Delete the existing PNG file of same name, if exists
    On Error Resume Next
        Kill Environ$("temp") & "\" & nameFile & ".png"
    On Error GoTo 0

    'Copy the range as picture
    rngToPicture.CopyPicture

    'Paste the picture in Chart area of same dimensions
    With ThisWorkbook.Worksheets(wksName).ChartObjects.Add(rngToPicture.Left, rngToPicture.Top, rngToPicture.Width, rngToPicture.Height)
        .Activate
        .Chart.Paste
        'Export the chart as PNG File to Temp folder
        .Chart.Export Environ$("temp") & "\" & nameFile & ".png", "PNG"
    End With
    Worksheets(wksName).ChartObjects(Worksheets(wksName).ChartObjects.Count).Delete

End Sub