Подскажите, пожалуйста, по следующему вопросу: Хочу вставить в подпись изображение. Прописал код, но изображение вставляется сверху сообщения, а не с низу. Подскажите как исправить, что бы изображение вставлялось снизу под подписью. Файлы во вложении. Код в спойлере.
Заранее благодарю.
Скрытый текст
Sub ТО_ПК_Кнопка() Dim objOutlookApp As Object, objMail As Object
Application.ScreenUpdating = False On Error Resume Next Set objOutlookApp = CreateObject("Outlook.Application") objOutlookApp.Session.Logon Set objMail = objOutlookApp.CreateItem(0) 'создаем новое сообщение If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub On Error GoTo 0 'создаем сообщение Dim arr, mailboxes As String arr = Range("C12:C200").Value For i = 1 To UBound(arr) If Len(mailboxes) = 0 Then mailboxes = arr(i, 1) Else mailboxes = mailboxes & "; " & arr(i, 1) End If Next i
Ничего не понятно. У Вас проблема-то конкретно в чем? В этом?
Цитата
SanyaMan90 написал: изображение вставляется сверху сообщения, а не с низу
так Вам конкретный намек дали куда смотреть. А именно: код добавления картинки у Вас идет ДО основного текста письма(это который .HTMLBody). Их надо поменять местами. Вроде не самая сложная задача, если вдуматься в смысл:
Воспользовался Вашей подсказкой, увы картинка вовсе перестала добавляться. Прикрепляю файл и скрины во вложение. Код в спойлере.
Скрытый текст
Sub ТО_ПК_Кнопка() Dim objOutlookApp As Object, objMail As Object Dim strbody As String Dim width As String Dim height As String
Application.ScreenUpdating = False On Error Resume Next Set objOutlookApp = CreateObject("Outlook.Application") objOutlookApp.Session.Logon Set objMail = objOutlookApp.CreateItem(0) 'создаем новое сообщение If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub On Error GoTo 0 'создаем сообщение Dim arr, mailboxes As String arr = Range("C12:C200").Value For i = 1 To UBound(arr) If Len(mailboxes) = 0 Then mailboxes = arr(i, 1) Else mailboxes = mailboxes & "; " & arr(i, 1) End If Next i
.HTMLBody = .HTMLBody & "<br>" & strbody & "<br><br>" _ & "<img src='cid:logo.jpg'" & "width=width height=heigth><br><br>" End With
Set objOutlookApp = Nothing: Set objMail = Nothing Application.ScreenUpdating = True End Sub
Function ConvertRngToHTM(rng As Range) Dim fso As Object, ts As Object Dim sF As String, resHTM As String Dim wbTmp As Workbook
sF = Environ("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm" 'переносим указанный диапазон в новую книгу rng.Copy Set wbTmp = Workbooks.Add(1) With wbTmp.Sheets(1) 'вставляем только ширину столбцов, значения и форматы .Cells(1).PasteSpecial xlPasteColumnWidths .Cells(1).PasteSpecial xlPasteValues .Cells(1).PasteSpecial xlPasteFormats .Cells(1).Select Application.CutCopyMode = False 'удаляем все объекты(фигуры, рисунки и пр.) '------------------------------------------ 'если рисунки и объекты нужны - удалить этот блок On Error Resume Next .DrawingObjects.Visible = True .DrawingObjects.Delete On Error GoTo 0 '------------------------------------------ End With 'сохраняем книгу как Веб-страницу(чтобы содержимое конвертировать в HTML-код) With wbTmp.PublishObjects.Add( _ SourceType:=xlSourceRange, Filename:=sF, _ Sheet:=wbTmp.Sheets(1).Name, Source:=wbTmp.Sheets(1).UsedRange.Address, _ HtmlType:=xlHtmlStatic) .Publish (True) End With 'открываем созданный файл как текстовый и считываем содержимое Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.GetFile(sF).OpenAsTextStream(1, -2) resHTM = ts.ReadAll ts.Close 'выравниваем таблицу по левому краю(если надо оставить по центру - удалить эту строку) ConvertRngToHTM = Replace(resHTM, "align=center x:publishsource=", "align=left x:publishsource=") 'закрываем временную книгу и удаляем wbTmp.Close False Kill sF 'очищаем объектные переменные Set ts = Nothing: Set fso = Nothing Set wbTmp = Nothing End Function
А что должно вставляться? У меня Ваш код изначально не работал, т.к. переменные TempFilePath и strbody просто пусты. Следовательно картинку вставить просто неоткуда. И переменная olByValue какое у Вас значение имеет? Правильно - никакого, т.к. Excel про неё ничего не знает. Как только разберетесь с этими проблемами - все заработает без проблем.
P.S. Не надо писать мне в личные сообщения, чтобы я решал Вашу задачу. Будет время и желание посмотрю без подсказок.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...