Картинка из Exel в Outlook

Дата: Среда, 01.03.2017, 09:10 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 146

Репутация: 0 ±

Замечаний: 40% ±

2007

Уважаемые форумчане, доброго времени суток!
В очередной раз нужна ваша помощь. Мне нужно из Exel в Outlook при отправке e-mail в качестве подписи последней строкой в теле письма вставлять картинки. Пробовал в Outlook делать шаблон подписи с картинкой, а затем выводить ее через "C:\Users\1\Microsoft\Signatures\...." но ничего не вышло. На просторах интернета увидел, что есть возможность копировать таблицу на листе Exel и вставлять в тело письма. С картинкой так не получается. Может у кого нибудь есть идеи.
[vba]

Код

Sub SendMail()

Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

ActiveSheet.Range("A1:C20").CopyPicture Appearance:=xlScreen, Format:=xlPicture 'Format:=xlBitmap

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")   'запускаем Outlook в скрытом режиме
    OutApp.Session.Logon ("pravka@tut.by") ' учетная запись в Outlook с которой будет уходить почта
    On Error GoTo cleanup

    Set OutMail = OutApp.CreateItem(0)   'создаем новое сообщение
    On Error Resume Next    'заполняем поля сообщения

        With OutMail
            .To = "tests@tut.by"
            .Subject = "Ура"
            .Body = "1.строка" & Chr(13) & "2.строка"
            .Display   'команду Send можно заменить на Display, чтобы посмотреть сообщение перед отправкой
            SendKeys "^{END}", True
            SendKeys "^v", True
        End With

        On Error GoTo 0
        Set OutMail = Nothing

cleanup:
        Set OutApp = Nothing
        Application.ScreenUpdating = True
End Sub

[/vba]

Код

[/vba]A_3485

СообщениеУважаемые форумчане, доброго времени суток!
В очередной раз нужна ваша помощь. Мне нужно из Exel в Outlook при отправке e-mail в качестве подписи последней строкой в теле письма вставлять картинки. Пробовал в Outlook делать шаблон подписи с картинкой, а затем выводить ее через "C:\Users\1\Microsoft\Signatures\...." но ничего не вышло. На просторах интернета увидел, что есть возможность копировать таблицу на листе Exel и вставлять в тело письма. С картинкой так не получается. Может у кого нибудь есть идеи.
[vba]

Код

[/vba]

Автор - A_3485
Дата добавления - 01.03.2017 в 09:10

Дата: Среда, 01.03.2017, 16:25 | Сообщение № 2

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 167

Репутация: 43 ±

Замечаний: 0% ±

Excel 2007, 2010

A_3485 И парки Temp на диске C вставляет в тело письма картинку "картинка.bmp".

[vba]

Код

Dim OutApp As Object
Dim OutMail As Object
Dim TempFilePath As String

TempFilePath = "C:\temp\"

Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)

With OutMail

 .Subject = "ТЕМА"
 .To = "tests@tut.by"

 .Attachments.Add TempFilePath & "картинка.bmp", 0, 0

 .HTMLBody = "" & "" & "<img src='cid:картинка.bmp'" & ""

 .Display

End With

Set OutApp = Nothing
Set OutMail = Nothing

[/vba]

Сообщение отредактировал devilkurs - Среда, 01.03.2017, 16:30

Дата: Среда, 01.03.2017, 16:33 | Сообщение № 3

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 146

Репутация: 0 ±

Замечаний: 40% ±

2007

devilkurs, спасибо через .HTMLBody - получилось. Только теперь другая проблема. Если делать рассылку на много адресов и использовать метод SEND, то картинки не приходят. Я так понимаю, что картинки не успевают уйти т.к. слишком все быстро происходит. Можно как-то поставить таймааут на оптарвку сообщения. Например через 3 секунды. devilkurs,

Дата: Среда, 01.03.2017, 16:46 | Сообщение № 4

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 167

Репутация: 43 ±

Замечаний: 0% ±

Excel 2007, 2010

A_3485, на сколько я знаю паузу можно сделать так:
[vba]

Код

Application.Wait (Now + TimeValue("0:00:01"))'на 1 сек

[/vba]

Дата: Среда, 01.03.2017, 16:49 | Сообщение № 5

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 146

Репутация: 0 ±

Замечаний: 40% ±

2007

..... куда эту строчку тогда вставить?
добавил сюда:
[vba]

Код

.....
.....
.htmlBody = htmlBody
Application.Wait (Now + TimeValue("0:00:03"))

[/vba]

Письма вроде ушли, только без картинок

Сообщение отредактировал A_3485 - Среда, 01.03.2017, 16:54

Дата: Среда, 01.03.2017, 16:56 | Сообщение № 6

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 167

Репутация: 43 ±

Замечаний: 0% ±

Excel 2007, 2010

A_3485, перед SEND думаю. чтоб успело загрузится все в тело письма. Я паузами не пользовался ни разу, не могу Вам точно подсказать

Дата: Среда, 01.03.2017, 16:59 | Сообщение № 7

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 167

Репутация: 43 ±

Замечаний: 0% ±

Excel 2007, 2010

A_3485, Вы используете один и тот же файл картинки? просто его удаляете и новый создаете? тогда перед удалением/перезаписи файла

Дата: Среда, 01.03.2017, 17:05 | Сообщение № 8

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 146

Репутация: 0 ±

Замечаний: 40% ±

2007

Да, картинка одна и та же. Вот так:
[vba]

Код

Application.Wait (Now + TimeValue("0:00:02")) 'на 2 сек
Set OutMail = Nothing

cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True

[/vba]

так тоже ничего не получилось. Текст отправляет, а картинку нет.
Если делать через DISPLAY, то все класс. Но 500 и более писем так будет трудно отправить.

Сообщение отредактировал A_3485 - Среда, 01.03.2017, 17:12