Добавить изображение в тело Outlook HTML с помощью Excel VBA

Я пытаюсь добавить изображение из листа Excel в электронную почту Outlook.Добавить изображение в тело Outlook HTML с помощью Excel VBA

Я уже пробовал использовать ссылку на изображение, хранящееся в сетевом расположении и в Интернете. Однако не все пользователи получат доступ к этим решениям.

Можно ли сохранить изображение на другом листе, а затем скопировать его в тело электронной почты?

Я знаю, что нижеследующее не будет работать, потому что вы не можете экспортировать фигуры, но могу ли я сделать что-то вроде этого?

ActiveUser = Environ$("UserName") 
TempFilePath = "C:\Users\" & ActiveUser & "\Desktop\" 

Sheets("Images").Shapes("PanelComparison").Export TempFilePath & "\PanelComparison.png" 
panelimage = "<img src = ""TempFilePath\PanelComparison.png"" width=1000 height=720 border=0>"

источник

2013-03-13 evoandy

В общих изображениях электронной почты хранятся на веб-сервере, с SRC указывает на этот сервер (http://...). Они не встроены в электронную почту.

источник

2013-03-13 14:25:17

Хорошо, спасибо, но это не r Ответьте, как я могу поместить изображение в excel в электронное письмо. – evoandy

Возможно, вы сможете сделать это как приложение. Смотрите: http://stackoverflow.com/questions/6224766/how-to-add-an-embedded-image-to-an-html-message-in-outlook-2010 –

Я мог бы прикрепить их, но в идеале я хочу, чтобы они были в пределах тело электронной почты – evoandy

Подменю CreateEmail Sub вызывает SaveToImage Sub. Субтитр SaveToImage захватывает диапазон, создает диаграмму на новой странице, а затем сохраняет изображение (objChart) в указанный каталог.

Строковая переменная LMpic вызывает только что сохраненное изображение и вводит его в тело HTML.

Public Sub CreateEmail() 

Dim OutApp As Object 
Dim OutMail As Object 
Dim cell As Range 
Dim FN, LN, EmBody, EmBody1, EmBody2, EmBody3 As String 
Dim wb As Workbook 
Dim ws As Worksheet 

Application.ScreenUpdating = False 
Set OutApp = CreateObject("Outlook.Application") 

Set wb = ActiveWorkbook 
Set ws = Worksheets("Sheet1") 

Call SaveToImage 


ws.Activate 

LMpic = wb.Path & "\ClarityEmailPic.jpg'" 

On Error GoTo cleanup 
For Each cell In Columns("D").Cells.SpecialCells(xlCellTypeConstants) 
    If cell.Value Like "?*@?*.?*" Then 

     FN = Cells(cell.Row, "B").Value 
     LN = Cells(cell.Row, "A").Value 
     EmBody = Range("Email_Body").Value 
     EmBody1 = Range("Email_Body1").Value 
     EmBody2 = Range("Email_Body2").Value 
     'EmBody3 = Range("Email_Body3").Value 

     Set OutMail = OutApp.CreateItem(0) 
     On Error Resume Next 
     With OutMail 
      .To = cell.Value 
      .Subject = "Volt Clarity Reminder " 
      .Importance = olImportanceHigh 
      .HTMLBody = "<html><br><br><br>" & _ 
          "<table border width=300 align=center>" & _ 
           "<tr bgcolor=#FFFFFF>" & _ 
            "<td align=right>" & _ 
             "<img src='" & objRange & "'>" & _ 
            "</td>" & _ 
           "</tr>" & _ 
           "<tr border=0.5 height=7 bgcolor=#102561><td colspan=2></td></tr>" & _ 
           "<tr>" & _ 
            "<td colspan=2 bgcolor=#E6E6E6>" & _ 
            "<body style=font-family:Arial style=backgroung-color:#FFFFFF align=center>" & _ 
              "<p> Dear " & FN & " " & LN & "," & "</p>" & _ 
              "<p>" & EmBody & "</p>" & _ 
              "<p>" & EmBody2 & "<i><font color=red>" & EmBody1 & "</i></font>" & "</p>" & _ 
            "</body></td></tr></table></html>" 
      .Display 'Or use Display 
     End With 

     On Error GoTo 0 
     Set OutMail = Nothing 

    End If 
Next cell

очистки: Set OutApp = Nothing Application.ScreenUpdating = True End Sub

Public Sub SaveToImage() ' ' SaveToImage Макро '

Dim DataObj As Shape 
Dim objChart As Chart 
Dim folderpath As String 
Dim picname As String 
Dim ws As Worksheet 

Application.ScreenUpdating = False 

Set ws = Worksheets("Sheet2") 

folderpath = Application.ActiveWorkbook.Path & Application.PathSeparator 'locating & assigning current folder path 
picname = "ClarityEmailPic.jpg" 'image file name 

Application.ScreenUpdating = False 

Call ws.Range("Picture").CopyPicture(xlScreen, xlPicture) 'copying the range as an image 

Worksheets.Add(after:=Worksheets(1)).Name = "Sheet4" 'creating a new sheet to insert the chart 
ActiveSheet.Shapes.AddChart.Select 
Set objChart = ActiveChart 
ActiveSheet.Shapes.Item(1).Width = ws.Range("Picture").Width 'making chart size match image range size 
ActiveSheet.Shapes.Item(1).Height = ws.Range("Picture").Height 

objChart.Paste 'pasting the range to the chart 
objChart.Export (folderpath & picname) 'creating an image file with the activechart 

Application.DisplayAlerts = False 
ActiveWindow.SelectedSheets.Delete 'deleting sheet4 
Application.DisplayAlerts = True

End Sub

источник

2015-05-29 18:51:05 James

Добавить изображение в тело Outlook HTML с помощью Excel VBA

ответ

Смежные вопросы