Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
e-mail в outlook с таблицей в теле письма из Excel макросовой кнопкой
 
#1
06.12.2014 19:29:02
Помогите, пожалуйста, пытаюсь упростить процесс заполнения и одобрения форм-опросников.
Есть список полей с вопросами, ответы на которые я добавила в связанные списки и т.п. Все работает  :)  
Теперь осталось всю эту красоту (таблицу по диапазону) одним нажатие кнопки отправить в outlook для дальнейшей отправки.
Т.е. Необходимо сформировать тело письма, в которое надо вставить определенный Range таблицы (10x10 ячеек) и добавить текст-обрамление (фиксированный: обращение, подпись и т.п.).
Нашла макрос в интернете, но он почему-то никак не работает (нажимаю на кнопку и ничего!). Вот как блонди сижу и думаю, что делать?
Код
 Sub CommandButton1_Click()
    Dim mailApp As Outlook.Application
    Dim dfg As Object

'поиск окна Microsoft Outlook
    lngRetVal = FindWindowByClass("rctrl_renwnd32", 0&;)
        If lngRetVal <> 0 Then
    Set mailApp = GetObject(, "Outlook.Application")
     Else
    Set mailApp = CreateObject("Outlook.Application")
    End If

    Set objMail = mailApp.CreateItem(olMailItem)
    Set dfg = objMail.Recipients.Add("test@test.com")
    dfg.Type = olTo

With objMail
    .Importance = olImportanceHigh
    .Subject = "Your Subject"
    .BodyFormat = olFormatHTML 'формат HTML
    .HTMLBody = SheetToHTML(ThisWorkbook.Worksheets("tasks"))
End With


'Предварительный просмотр письма 
'objMail.Display

'Отправка письма
objMail.Send


Set objMail = Nothing
Set mailApp = Nothing


End Sub
Изменено: Iv_Juliette - 06.12.2014 19:43:06
 
 
 
#2
06.12.2014 19:34:49
Оформляйте коды соответстующим тегом. Для этого существует специальная кнопка:

И поудаляйте пустые строки.
 
 
 
#3
06.12.2014 20:18:33
Цитата
Iv_Juliette пишет: Вот как блонди
Будут доказательства,получите макрос  :D  
А пока скопируйте в модуль к вашему макросу с источника
две функции
Код
Public Function SheetToHTML(sh As Worksheet)  
......................................... 
................................................ 
End Function
Declare Function FindWindowByClass Lib "user32" _ Alias "FindWindowA" (ByVal lpClassName As String, _ ByVal lpWindowName As Long) As Long
 
 
 
#4
06.12.2014 20:42:26
Страшно спросить, какие нужны доказательства;)
но в VBA я реально плохо разбираюсь, знаю азы, которым учат в университете.
Я решила прогнать макрос по коду и он мне выдает ошибку на самом начале, когда задается MailApp как Outlook.Application. :(
 
 
 
#5
06.12.2014 20:46:07
Цитата
Iv_Juliette пишет: Страшно спросить, какие нужны доказательства
Фото без парика.
 
 
 
#6
06.12.2014 21:18:01
Все-то вы видите))))
 
 
 
#7
06.12.2014 21:20:27
:D
 
 
 
#8
06.12.2014 21:40:49
Цитата
Iv_Juliette пишет: Все-то вы видите))))
Я не увидел...
There is no knowledge that is not power
 
 
 
#9
06.12.2014 21:51:59
Цитата
Iv_Juliette пишет: Страшно спросить, какие нужны доказательства;
Годится.Шутку не поняли.  :)  
Ваш код будет такой,за исключением конвертации в HTML
Код
Dim mailApp As Object
Set mailApp = CreateObject("Outlook.Application")
With mailApp.CreateItem(0)
      .To = "test@test.com"
    .Subject = "Your Subject"
    .BodyFormat = 2
    .HTMLBody = SheetToHTML(ThisWorkbook.Worksheets("tasks"))
    .Send
End With
Set mailApp = Nothing
PS:Юра ясновидящий
Изменено: Doober - 06.12.2014 21:55:23
 
 
 
#10
06.12.2014 22:15:29
Ошибка во второй строчке - "ActiveX component can't create an object"  :oops:  
И не поняла про HTML конвертацию.....
Код
Declare Function FindWindowByClass Lib "user32" _ Alias "FindWindowA" (ByVal lpClassName As String, _ ByVal lpWindowName As Long) As Long
и эта функция не распознается в модуле...
Изменено: Iv_Juliette - 06.12.2014 22:16:37
 
 
 
#11
06.12.2014 22:45:31
Цитата
Iv_Juliette пишет: Ошибка во второй строчке - "ActiveX component can't create an object"
Значит у вас не установлен аутлук.
2 варианта.
1. Отправка через командную строку почтовой программы,если она у вас есть.
2.отправка средствами винды  при помощи CDO
Изменено: Doober - 06.12.2014 23:03:56
 
 
 
#12
06.12.2014 22:47:54
Iv_Juliette, извините, а зачем использовать Windows API?
Это для чего??

Код
lngRetVal = FindWindowByClass("rctrl_renwnd32", 0&;)
There is no knowledge that is not power
 
 
 
#13
06.12.2014 22:50:53
Написала код функции преобразования 8)
Код
Public Function SheetToHTML(sh As Worksheet)
      Dim TempFile As String
    Dim fso As Object
    Dim ts As Object
      sh.Copy
    TempFile = sh.Parent.Path & "\TempHtml.htm"
      With ActiveWorkbook.PublishObjects.Add(xlSourceRange, _
    TempFile, "Sheet1", "A1:F30", xlHtmlStatic, "333_8568" _
    , "")
    .Publish (True)
    .AutoRepublish = False
    End With
      ActiveWorkbook.Close False
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
      SheetToHTML = ts.ReadAll
   ts.Close
    Set ts = Nothing
    Set fso = Nothing
    Kill TempFile
    End Function

Остался вопрос текста-обрамления и несколько моментов редактирования.
- внести фиксированный текст письма + подпись определенного формата?
- таблица в тело письма вставляется по центру, как сделать по левому краю?
 
 
 
#14
06.12.2014 22:53:11
Цитата
Doober пишет: Значит у вас не установлен аутлук.
Я не до такой степени "блонди"  :D  
все заработало, осталось навести общий блеск  8)  
Цитата
Johny пишет: зачем использовать Windows API?
слишком заумный для меня вопрос...хз  :D    
 
 
 
#15
06.12.2014 22:57:57
Цитата
Iv_Juliette пишет: слишком заумный для меня вопрос...хз
Тогда уберите его - он не нужен.  :D
There is no knowledge that is not power
 
 
 
#16
06.12.2014 23:08:11
Я воспользовалась кодом от мага и чародея Doober  :)  
За что ему ОГРОМНЕЙШЕЕ СПАСИБО!!! Он просто спас мой последний выходной :)

Текст-обрамление решила вставить в таблицу и расширить диапазон вставки в тело письма, а в excelнике просто их "зашить" от лишних глаз...работает))
Но всё же, как вставку сделать по левому краю?  :(
Изменено: Iv_Juliette - 06.12.2014 23:11:57
 
 
 
#17
07.12.2014 00:31:30
Цитата
Iv_Juliette пишет: Но всё же, как вставку сделать по левому краю?
Закоментируйте строку кода   Kill TempFile
Заполните ваш секретный диапазон любыми значениями.
Созданый файл TempHtml.htm выложите в теме.
Почитаю его и найдем решение
 
 
 
#18
07.12.2014 18:23:58
Kill TempFile - удаление временного файла, с помощью которого прошло преобразование...  :oops:  
Файлик преобразовать в html не могу....
 
 
 
#19
07.12.2014 20:27:40
Цитата
Файлик преобразовать в html не могу....
И не надо,вы его  в теме выложите.
 
 
 
#20
07.12.2014 20:34:16
TempHtml.xlsm (24.34 КБ)
допустим что-то вроде этого...
подбираю методом "тыка"... кручу-верчу функцию Align, но пока безрезультатно(((
 
 
 
#21
07.12.2014 22:43:37
Цитата
Iv_Juliette пишет: подбираю методом "тыка"... кручу-верчу функцию Align
Теперь работает правильно
Скрытый текст
Изменено: Doober - 07.12.2014 23:40:51
 
 
 
#22
07.12.2014 22:59:42
Вы ГЕНИЙ!!!!!! :D  
Спасибо! :D  Моему счастью нет предела!
Танцую....т.к. поздно уже для других проявлений радости)))  
 
 
 
#23
07.12.2014 23:41:42
Эй вы ,там, наверху
Не топочите, как слоны!
:)
 
 
 
#24
24.04.2015 09:59:35
добрый день ! очень прошу помощи
есть таблица короткий пример во вложении. нужно чтобы формировал письма адресат берется из столбца ФИО
а вот в теле данные из столбцов "дело1 дата дело1 результат
" из соответствующих ФИО строк то есть у васи пупкина будет выглядеть так
......
.To = "ВасяПупкин@mail.ru"
.Body = 123 01.04.2015 +
123 03.04.2015 -
.Display

вот как в тело вставить данные я не понимаю (
помогите пожалуйста
 
 
 
#25
24.04.2015 13:10:11
Как-то так это выглядит в Excel (c забором темы, адреса, сообщения с листа Excel - "Данные" )
Можно сделать перебор по строкам "Х" , с рассылкой разных писем (в данном случае по 100 строкам).
Номера столбцов в Cells() поставте свои.

Код
...
For x = 1 To 100 Step 1 
 
Set OutlookApp = CreateObject("Outlook.Application")
 Set SM = OutlookApp.CreateItem(olMailItem)
 адрес = Sheets("Данные").Cells(x, 17)
 тема = Sheets("Данные").Cells(x, 18)
 сообщение = Sheets("Данные").Cells(x, 19)
 SM.To = адрес
 SM.Subject = тема
 сообщение2 = Replace(сообщение, "vbNewLine", "<br>")
 SM.HTMLBody = "<FONT Size = 2> " & сообщение2 & " </FONT>"
 SM.send
 
Next x
...
«Бритва Оккама» или «Принцип Калашникова»?
 
 
 
#26
20.05.2019 15:29:54
Уважаемые ГУРУ!
Помогите, пожалуйста. Я не могу никак совладать с прикреплением файла, а также таблицы в тело письма. Пример файла во вложении.

С вложением - может ли быть проблема в том, что путь к файлу формируется формулой?
Не могу никак понять, как прописать код, чтобы таблица с листа (имя листа = имя менеджера из таблицы в email) вставлялась в тело письма :(
я уже несколько макросов разных перепробовала, не могу я их под свой файл подпилить.

Плиииз ХЕЛП!

Вот имеющийся код, который прекрасно создает и отправляет письма, однако не вставляет таблицу и файл.
А еще вопрос, как прописать определенный шрифт и цвет тексту в письме?
Код
Sub CreateMail()
    Dim stFileName As String
    Dim objOutlook As Object
    Dim objMail As Object
    Dim rngEntry As Range
    Dim rngEntries As Range

    Set objOutlook = CreateObject("Outlook.Application")
    Set rngEntries = Worksheets("emails").Range("Sales_mail")
    
    For Each rngEntry In rngEntries
    stFileName = rngEntry.Offset(0, 2)
    If Dir(stFileName) <> "" Then
    
        Set objMail = objOutlook.CreateItem(0)
        With objMail
        
       On Error Resume Next
          
            .To = rngEntry.Offset(0, 0).Value
            .CC = rngEntry.Offset(0, 3).Value
            .Subject = rngEntry.Offset(0, 2).Value
            .Body = Range("F1")
            
            .Attachments.Add (rngEntry.Offset(0, 4).Value)
            .Send '.Display or .save
        End With
        
        Else
         MsgBox "No data for" & " " & rngEntry.Offset(0, -1).Value
    End If
        Next rngEntry
        
    Set objOutlook = Nothing
    Set objMail = Nothing
    Set rngEntry = Nothing
    Set rngEntries = Nothing

End Sub
 
 
 
#27
20.05.2019 15:33:23
Мария -, Я вам скинул ссылку с сайта Дмитрия Щербакова, скачайте файл, и попробуйте запустить макрос, посмотрите так ли вам нужно, ну а далее по аналогии примените к своему файлу.
Изменено: Nordheim - 20.05.2019 15:33:46
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#28
20.05.2019 15:49:57
Nordheim, простите, у меня улетела подписка на ту тему, и ваш ответ я не увидела
 
 
 
#29
20.05.2019 17:57:35
Мария -, свою тему Вы легко можете найти: для этого нужно зайти в свой профиль и в правом нижнем углу нажать на кнопку "Темы".
 
 
 
Страницы: 1
Читают тему
Наверх