Вставка в Outlook из Excel - Обновление экрана Outlook

Question

Я нашел код для вставки диаграммы из Excel в Outlook здесь в стеке над потоком.

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

Sub Mail_Range()
    Dim Sht As Excel.Worksheet
    Set Sht = ThisWorkbook.ActiveSheet

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Dim rng As Range
    Set rng = Sht.Range("A5:W20")
        rng.Copy

    Dim OutApp As Object
    Set OutApp = CreateObject("Outlook.Application")

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


    Dim OutMail As Object
    Set OutMail = OutApp.CreateItem(0)

    Dim vInspector As Object
    Set vInspector = OutMail.GetInspector

    Dim wEditor As Object
    Set wEditor = vInspector.WordEditor

    With OutMail
        .TO = "xxx.xxx.com"
        .CC = ""
        .Subject = Sht.Range("A5").Value
        .GetInspector
         wEditor.Paragraphs(1).Range.Text = "This is an auto generated e-mail" & vbCr
         wEditor.Paragraphs(2).Range.Paste
        .send
    End With

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

    Application.CutCopyMode = False

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Когда я использую

With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With

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

Answer 1

Я думаю, что вы не можете запретить отображение экрана создания электронной почты, вызвав Word Editor подход. Если вы просмотрите предыдущие сообщения SO и комментарии опытных экспертов, становится совершенно ясно, что вы не можете запретить отображение экрана создания электронной почты.

Чтобы полностью отключить отображение экрана создания электронной почты, воспользуйтесь ссылками из программ на roundebruin , которые охватывают все типы возможностей отправки электронной почты без отображения экрана создания электронной почты. Вот небольшой вариант вашего кода, который работает для меня и опубликован, если кто-то найдет его полезным для аналогичной ситуации.

Public Sub Emails()
Dim str As String
Dim outlook As Object
Dim newEmail As Object
Dim xInspect As Object
Dim pageEditor As Object

With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

Set outlook = CreateObject("Outlook.Application")
Set newEmail = outlook.CreateItem(0)
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
str = ws1.Range("A5").Value
With newEmail
    .To = "xxx.xxx.com"
    .CC = ""
    .BCC = ""
    .Subject = str
    .body = ""
    .display

    Set xInspect = newEmail.GetInspector
    Set pageEditor = xInspect.WordEditor

   'Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    ws1.Range("A5").Copy
    pageEditor.Application.Selection.Paste xlValues
    ws1.Range("A5:W20").Copy
    pageEditor.Application.Selection.Paste xlValues

    .send
    Set pageEditor = Nothing
    Set xInspect = Nothing
End With

Set newEmail = Nothing
Set outlook = Nothing
With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Answer 2

Если ваша проблема в том, что вы не хотите видеть всю процедуру отправки почты, но если значение ScreenUpdating равно false, вы увидите пустое изображение, вот мой код для решения этой проблемы:

            Call AhorroMemoria(False)
            Imagen.CopyPicture xlScreen, xlBitmap
            With wsM.ChartObjects.Add(Imagen.Left - Imagen.Left * 0.15, Imagen.Top - Imagen.Top * 0.15, _
            Imagen.Width - Imagen.Width * 0.15, Imagen.Height - Imagen.Height * 0.15)
                .Activate
                wsM.Shapes("Gráfico 1").Line.Visible = msoFalse
                .Chart.Paste
                .Chart.Export wb.Path & "\" & Servicio & Contador & ".jpg", "JPG"
            End With
            Call AhorroMemoria(True)

Call AhorroMemoria(False) включает все, обновление экрана, enablevents и так далее ... Я делаю это только при копировании изображения, как вы можете видеть в коде, затем я снова выключаю все это на Call AhorroMemoria(True).

Надеюсь, это поможет.

Answer 3

Спасибо всем за помощь. Все ваши коды помогли каким-то образом. Но я нашел более простой код от Microsoft здесь . Я не уверен, какие версии будут поддерживать это, и у него есть другие проблемы. На данный момент это работает для меня в Office 2016 .

Я получаю почтовый конверт на короткое время в Excel, но никаких проблем, так как случайное редактирование не может быть выполнено с помощью этого метода. В оригинальном методе было возможно случайное редактирование во время работы функции вставки.

Кроме того, этот код легко отправляет диаграммы по электронной почте на лист Excel.

Option Explicit    
Sub Send_Range()

       ' Select the range of cells on the active worksheet.
       ActiveSheet.Range("A1:B5").Select

       ' Show the envelope on the ActiveWorkbook.
       ActiveWorkbook.EnvelopeVisible = True

       ' Set the optional introduction field thats adds
       ' some header text to the email body. It also sets
       ' the To and Subject lines. Finally the message
       ' is sent.
       With ActiveSheet.MailEnvelope
          .Introduction = "This is a sample worksheet."
          .Item.To = "E-Mail_Address_Here"
          .Item.Subject = "My subject"
          .Item.Send
       End With
    End Sub

Answer 4

Dim OutApp As Object
Set OutApp = CreateObject("Outlook.Application")

With Application  <<<---- change to OutApp
    .ScreenUpdating = False
    .EnableEvents = False
End With