Уважаемые форумчане!
Пожалуйста, помогите закончить процедуру.
Имеется word файл в котором существует таблица.
Файл открываю, определяю таблицу, но не получается вставить таблицу ворд файла в текст письма.
Пожалуйста, помогите закончить процедуру.
Имеется word файл в котором существует таблица.
Файл открываю, определяю таблицу, но не получается вставить таблицу ворд файла в текст письма.
| Код |
|---|
Sub Макрос1()
Dim objShell As Object
Dim objOutlookApp As Object, objMail As Object
Dim sTo As String, sCopy As String, sSubject As String, sBody As String
Dim WA As Word.Application, WDSaved As Word.Document, oTable As Word.Table
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
sTo = "" 'Кому
sCopy = "" 'Кому в копии
sSubject = "" ' Тема
sBody = "" 'Текст письма
sAttachment1 = "" 'Вложение(полный путь к файлу)
Set WA = New Word.Application
Set WDSaved = WA.Documents.Open("путь к ворд файлу")
Set oTable = WDSaved.Tables(1)
'создаем сообщение
With objMail
.To = sTo 'адрес получателя
.cc = sCopy 'адрес получателя в копии
.Subject = sSubject 'тема сообщения
.Body = sBody & ... вставить таблицу oTable 'текст сообщения
.Attachments.Add sAttachment1
.Display 'если необходимо просмотреть сообщение, а не отправлять без просмотра
'.Send 'отправлять без просмотра
End With
exit_:
Set objOutlookApp = Nothing: Set objMail = Nothing
WDSaved.Close False
WA.Quit
Set WA = Nothing
End Sub |
Изменено: - 06.01.2016 13:00:03
