Вставьте Excel Excel как изображение в тело письма VBA - PullRequest
Новая
       31

Вставьте Excel Excel как изображение в тело письма VBA

0 голосов
/ 11 марта 2019

, прежде чем кто-либо это предложит, я часами просматривал ранее отвеченные на подобные вопросы и не могу, пока не пойму, где ошибаюсь. Как и предполагалось, моя цель - вставить диапазон в виде изображения в электронное письмо Outlook. Я уже включил ссылки в редакторе VBA для MS Excel, Word и Outlook 15.0 в качестве моей последней версии в моей сети. Я не могу сохранить изображение как временный файл / использовать html, чтобы ссылаться на вложение как на решение, поскольку другие пользователи не имеют доступа к определенным дискам, где оно будет временно сохранено, если они запустят код на своих компьютерах.

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

Заранее спасибо 

Sub CreateEmail()


Dim OlApp As Object
Dim OlMail As Object
Dim ToRecipient As Variant
Dim CcRecipient As Variant
Dim PictureRange As Range
Dim OApp As Object, OMail As Object, signature As String


Set OlApp = CreateObject("Outlook.Application")
Set OlMail = OlApp.createitem(olmailitem)

ExtractName = ActiveWorkbook.Sheets("macros").Range("C11").Value

ToRecipient = ActiveWorkbook.Sheets("macros").Range("K11")
OlMail.Recipients.Add ToRecipient


CC_Check = ActiveWorkbook.Sheets("macros").Range("k10")
If CC_Check = "" Then GoTo Skip_CC

CcRecipient = ActiveWorkbook.Sheets("macros").Range("K10")

OlMail.Recipients.Add CcRecipient

OlMail.Subject = ExtractName
signature = OlMailbody
With OlMail
Set PictureRange = ActiveWorkbook.Sheets("DCTVV").Range("A2:D13")
PictureRange.Copy
OlMail.Display

Этот раздел вставляет изображение 

Dim wordDoc As Word.Document
        Set wordDoc = OlMail.GetInspector.WordEditor
              wordDoc.Range.PasteAndFormat wdChartPicture

Этот раздел - тело письма, которое нужно вставить в 

OlMail.body = "Text here," & vbNewLine & vbNewLine & _
        "Today's report is attached." & vbNewLine & _
        "IMAGE NEEDS TO BE PASTED HERE" _
      & vbNewLine & vbNewLine & "More text here" _
      & vbNewLine & vbNewLine & "Kind regards,"
.signature




    End With
    Set OMail = Nothing
    Set OApp = Nothing
    OlMail.Attachments.Add ("filepath &attachment1")
    OlMail.Attachments.Add ("filepath &attachment2")
    'OlMail.Attachments.Add ("filepath &attachment3")

    OlMail.Display 


End Sub

Ответы [ 2 ]

1 голос
/ 11 марта 2019

Из того, что я понимаю, картинка отлично вставляется в тело письма, верно?

В этом случае вам может просто понадобиться добавить .HTMLBody примерно так: 

olMail.HTMLBody = "Text here," & vbNewLine & vbNewLine & _
        "Today's report is attached." & vbNewLine & _
        .HTMLBody & _
        vbNewLine & vbNewLine & "More text here" & _
        vbNewLine & vbNewLine & "Kind regards,"
1 голос
/ 11 марта 2019

Это пример моего кода, который мы используем на моей работе, чтобы отправлять электронные письма: 

    Call CrearImagen
    ReDim myFileList(0 To Contador - 1)
    For i = 0 To Contador - 1
        myFileList(i) = wb.Path & "\" & Servicio & i & ".jpg"
        ImagenesBody = ImagenesBody & "<img src='cid:" & Servicio & i & ".jpg'>"
    Next i

    With OutMail
        .SentOnBehalfOfName = "ifyouwanttosendonbehalf"
        .Display
        .To = Para
        .CC = CC
        .BCC = ""
        .Subject = Asunto
        For i = 0 To UBound(myFileList)
            .Attachments.Add myFileList(i)
        Next i
        Dim Espacios As String

        Espacios = "<br>"
        For i = 0 To x
            Espacios = Espacios + "<br>"
        Next

        .HTMLBody = Saludo & "<br><br>" & strbody & "<br><br><br>" _
            & ImagenesBody _ 'here are the images
            & Espacios _ 'more text
            & .HTMLBody
        .Display
    End With
    On Error GoTo 0

'Reformateamos el tamaño de las imagénes y su posición relativa al texto

    Dim oL As Outlook.Application

    Set oL = GetObject("", "Outlook.application")
    Const wdInlineShapePicture = 3
    Dim olkMsg As Outlook.MailItem, wrdDoc As Object, wrdShp As Object
    Set olkMsg = oL.Application.ActiveInspector.CurrentItem
    Set wrdDoc = olkMsg.GetInspector.WordEditor
    For Each wrdShp In wrdDoc.InlineShapes
        If wrdShp.Type = wdInlineShapePicture Then
            wrdShp.ScaleHeight = 100
            wrdShp.ScaleWidth = 100
        End If
        If wrdShp.AlternativeText Like "cid:Imagen*.jpg" Then wrdShp.ConvertToShape
    Next

'Limpiamos los objetos
    For i = 0 To UBound(myFileList)
        Kill myFileList(i)
    Next i
    Set olkMsg = Nothing
    Set wrdDoc = Nothing
    Set wrdShp = Nothing
    Set OutMail = Nothing
    Set OutApp = Nothing

Теперь, если вы уже можете создавать изображения, просто сохраните их в пути к книге, и вы можете прикрепить их вот так. Прикрепляя изображения, я предлагаю вам, чтобы имена файлов не содержали пробелов, выяснил это нелегко, пока не понял, html не понравится им с пробелами.

...