ReSQL.ru
     
powered by simpleCommunicator - 2.0.36     © 2025 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Excel+Outlook: Отправка в теле письма таблицы
7 сообщений из 7, страница 1 из 1
Excel+Outlook: Отправка в теле письма таблицы
    #34731671
nanotronic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
nanotronic
Гость
Привет!

Столкнулся с проблемой, которую самостоятельно "победить" не смог .

Вводная :
Excel'ный документ с набором макросов и данных.

Что хотелось получить :
Необходимо сформировать тело письма, в которое надо вставить определенный Range таблицы (10x10 ячеек) и добавить текст ниже таблицы (не связано с таблицей).


Как я пытался сделать:


Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
Private Sub CommandButton1_Click()
    Dim mailApp As Outlook.Application
    Dim dfg As Object
    Dim BodyText As String

' ищу 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.ru")
    dfg.Type = olTo

With objMail
 
.Importance = olImportanceHigh
.Subject = "Your Subject"
.BodyFormat = olFormatHTML 'указал формат HTML
.Body = Worksheets("DATA").Range("A1").Text
End With

objMail.Send

Set objMail = Nothing
Set mailApp = Nothing

End Sub


С выделенной строкой пытаюсь "шаманить", но ничего не получается.
Думал, что можно на халяву указать примерно так, .Body = Worksheets("DATA").Range("A1:Z48").Text, а потом в довесок еще докинуть текстовых данных. Но низяяяяя....

Формировать строку в виде последовательности тегов html'ных этого Range, я не осилю


Помогите, pls.
Укажите в каком направлении копать или примером.

Спасибо!
...
Рейтинг: 0 / 0
16.08.2007, 11:23
| Ответить | Цитировать | Написать  
Excel+Outlook: Отправка в теле письма таблицы
    #34731908
AndrF
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
AndrF
Участник
nanotronicФормировать строку в виде последовательности тегов html'ных этого Range, я не осилю. Укажите в каком направлении копать или примером.

Дык примитив же:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
    SB.AppendLine "<html>"
    SB.AppendLine "<head>"
    SB.AppendLine "<meta http-equiv=""Content-Language"" content=""ru"">"
    SB.AppendLine "<meta http-equiv=""Content-Type"" content=""text/html; charset=windows-1251"">"
    SB.AppendLine "<title>Результаты выполнения задач</title>"
    SB.AppendLine "</head>"
    SB.AppendLine "<body>"
    SB.AppendLine "<p><font face=""Courier New"" size=2" & IIf(j, " color=""#FF0000""", vbNullString) & ">Ошибок: " & j & "</font></p>"
    SB.AppendLine "<table border=1 width=""100%"" id=""table1"" style=""border-collapse: collapse; font-family: Courier New; font-size: 8pt"">"
    SB.AppendLine "<tr style=""font-weight: bold; background-color: #FFFFCC"">"
    SB.AppendLine "<td align=center>Task</td>"
    SB.AppendLine "<td align=center>Begin Task</td>"
    SB.AppendLine "<td align=center>Executed</td>"
    SB.AppendLine "<td align=center>End Task</td>"
    SB.AppendLine "<td align=center>Error</td>"
    SB.AppendLine "</tr>"
...
    SB.AppendLine "</table>"
    SB.AppendLine "</body>"
    SB.AppendLine "</html>"
...
Рейтинг: 0 / 0
16.08.2007, 12:10
| Ответить | Цитировать | Написать  
Excel+Outlook: Отправка в теле письма таблицы
    #34732181
nanotronic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
nanotronic
Гость
AndrF nanotronicФормировать строку в виде последовательности тегов html'ных этого Range, я не осилю. Укажите в каком направлении копать или примером.

Дык примитив же:


спасибо!!!!
что то не воткнул сразу :)


А кстати - нет ли функции парсера таблиц с преобразованием на лету в теги?
Потенциально, должна быть внутренняя функция в Excel. Он же сам сохраняет файлы в этот формат.
...
Рейтинг: 0 / 0
16.08.2007, 13:12
| Ответить | Цитировать | Написать  
Excel+Outlook: Отправка в теле письма таблицы
    #34733092
nanotronic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
nanotronic
Гость
Вот еще одно решение.

Обходное, но выполняющее необходимые действия:

Процедура отправки таблицы в теле письма:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
Private 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


"Функция-хак" псевдопреобразования таблицы в набор html'ных тегов для BODY письма.

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
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, "tasks", "A1:Z48", 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

Декларация функции поиска запущенных процессов

Код: plaintext
1.
2.
Declare Function FindWindowByClass Lib "user32" _
    Alias "FindWindowA" (ByVal lpClassName As String, _
    ByVal lpWindowName As Long) As Long


Надеюсь, кому-нибудь это тоже пригодиться.
...
Рейтинг: 0 / 0
16.08.2007, 16:44
| Ответить | Цитировать | Написать  
Excel+Outlook: Отправка в теле письма таблицы
    #34733106
AndrF
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
AndrF
Участник
nanotronicА кстати - нет ли функции парсера таблиц с преобразованием на лету в теги?
Потенциально, должна быть внутренняя функция в Excel. Он же сам сохраняет файлы в этот формат.

Да набросай сам - оно ведь тоже примитив - в зависимости от типа поля, к примеру.
...
Рейтинг: 0 / 0
16.08.2007, 16:46
| Ответить | Цитировать | Написать  
Excel+Outlook: Отправка в теле письма таблицы
    #34733202
nanotronic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
nanotronic
Гость
AndrFДа набросай сам - оно ведь тоже примитив - в зависимости от типа поля, к примеру.

Думаю, да, сделаю как-нибудь на досуге.
Пока текущее решение буду использовать.
...
Рейтинг: 0 / 0
16.08.2007, 17:13
| Ответить | Цитировать | Написать  
Период между сообщениями больше года.
Excel+Outlook: Отправка в теле письма таблицы
    #39499604
Andy7711
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Andy7711
Гость
nanotronic,
добрый день!
Прошу подсказать как скомпилировать вместе данный код и код отправки таблицы в теле письма
текущий код у меня есть. Буду благодарен.

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
Sub Рассылка1()
  
    Dim objOutlookApp As Object, objMail As Object
    Dim lr As Long, lLastR As Long
  
    Application.ScreenUpdating = False
    On Error Resume Next
    Set objOutlookApp = CreateObject("Outlook.Application")
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
    objOutlookApp.Session.Logon

    lLastR = Cells(Rows.Count, 1).End(xlUp).Row 
    For lr = 2 To lLastR
        Set objMail = objOutlookApp.CreateItem(0)   
        With objMail
            .to = Cells(lr, 1).Value 
            .Subject = Cells(lr, 2).Value 
            .body = Cells(lr, 3).Value
            .Attachments.Add Cells(lr, 4).Value
            .Send 'Display,
            End With
            Next lr

    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub


Модератор: Учимся использовать тэги оформления кода - FAQ
...
Рейтинг: 0 / 0
03.08.2017, 12:18
| Ответить | Цитировать | Написать  
7 сообщений из 7, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Excel+Outlook: Отправка в теле письма таблицы
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
NoSQL.ru             Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=60&msg=34733202&tid=2155232]:
 0ms
get settings:
 10ms
get forum list:
 12ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 45ms
get topic data:
 12ms
get forum data:
 2ms
get page messages:
 46ms
get tp. blocked users:
 1ms
others: 13ms
total:  149ms
созд. / загр.: 149ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]