Страницы: 1
RSS
e-mail в outlook с таблицей в теле письма из Excel макросовой кнопкой
 
Помогите, пожалуйста, пытаюсь упростить процесс заполнения и одобрения форм-опросников.
Есть список полей с вопросами, ответы на которые я добавила в связанные списки и т.п. Все работает  :)  
Теперь осталось всю эту красоту (таблицу по диапазону) одним нажатие кнопки отправить в 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
 
Оформляйте коды соответстующим тегом. Для этого существует специальная кнопка:

И поудаляйте пустые строки.
 
Цитата
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
 
Страшно спросить, какие нужны доказательства;)
но в VBA я реально плохо разбираюсь, знаю азы, которым учат в университете.
Я решила прогнать макрос по коду и он мне выдает ошибку на самом начале, когда задается MailApp как Outlook.Application. :(
 
Цитата
Iv_Juliette пишет: Страшно спросить, какие нужны доказательства
Фото без парика.
 
Все-то вы видите))))
 
:D
 
Цитата
Iv_Juliette пишет: Все-то вы видите))))
Я не увидел...
There is no knowledge that is not power
 
Цитата
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
 
Ошибка во второй строчке - "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
 
Цитата
Iv_Juliette пишет: Ошибка во второй строчке - "ActiveX component can't create an object"
Значит у вас не установлен аутлук.
2 варианта.
1. Отправка через командную строку почтовой программы,если она у вас есть.
2.отправка средствами винды  при помощи CDO
Изменено: Doober - 06.12.2014 23:03:56
 
Iv_Juliette, извините, а зачем использовать Windows API?
Это для чего??

Код
lngRetVal = FindWindowByClass("rctrl_renwnd32", 0&;) 
There is no knowledge that is not power
 
Написала код функции преобразования 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

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

Текст-обрамление решила вставить в таблицу и расширить диапазон вставки в тело письма, а в excelнике просто их "зашить" от лишних глаз...работает))
Но всё же, как вставку сделать по левому краю?  :(
Изменено: Iv_Juliette - 06.12.2014 23:11:57
 
Цитата
Iv_Juliette пишет: Но всё же, как вставку сделать по левому краю?
Закоментируйте строку кода   Kill TempFile
Заполните ваш секретный диапазон любыми значениями.
Созданый файл TempHtml.htm выложите в теме.
Почитаю его и найдем решение
 
Kill TempFile - удаление временного файла, с помощью которого прошло преобразование...  :oops:  
Файлик преобразовать в html не могу....
 
Цитата
Файлик преобразовать в html не могу....
И не надо,вы его  в теме выложите.
 
TempHtml.xlsm (24.34 КБ)
допустим что-то вроде этого...
подбираю методом "тыка"... кручу-верчу функцию Align, но пока безрезультатно(((
 
Цитата
Iv_Juliette пишет: подбираю методом "тыка"... кручу-верчу функцию Align
Теперь работает правильно
Скрытый текст
Изменено: Doober - 07.12.2014 23:40:51
 
Вы ГЕНИЙ!!!!!! :D  
Спасибо! :D  Моему счастью нет предела!
Танцую....т.к. поздно уже для других проявлений радости)))  
 
Эй вы ,там, наверху
Не топочите, как слоны!
:)
 
добрый день ! очень прошу помощи
есть таблица короткий пример во вложении. нужно чтобы формировал письма адресат берется из столбца ФИО
а вот в теле данные из столбцов "дело1 дата дело1 результат
" из соответствующих ФИО строк то есть у васи пупкина будет выглядеть так
......
.To = "ВасяПупкин@mail.ru"
.Body = 123 01.04.2015 +
123 03.04.2015 -
.Display

вот как в тело вставить данные я не понимаю (
помогите пожалуйста
 
Как-то так это выглядит в 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
...
«Бритва Оккама» или «Принцип Калашникова»?
 
Уважаемые ГУРУ!
Помогите, пожалуйста. Я не могу никак совладать с прикреплением файла, а также таблицы в тело письма. Пример файла во вложении.

С вложением - может ли быть проблема в том, что путь к файлу формируется формулой?
Не могу никак понять, как прописать код, чтобы таблица с листа (имя листа = имя менеджера из таблицы в 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
 
Мария -, Я вам скинул ссылку с сайта Дмитрия Щербакова, скачайте файл, и попробуйте запустить макрос, посмотрите так ли вам нужно, ну а далее по аналогии примените к своему файлу.
Изменено: Nordheim - 20.05.2019 15:33:46
"Все гениальное просто, а все простое гениально!!!"
 
Nordheim, простите, у меня улетела подписка на ту тему, и ваш ответ я не увидела
 
Мария -, свою тему Вы легко можете найти: для этого нужно зайти в свой профиль и в правом нижнем углу нажать на кнопку "Темы".
Страницы: 1
Наверх