[решено] Почта из Excell некоторые вопросы

[Pryanik88]

Есть код который делает рассылку, через outlook , из книги excell . Необходимо вставить в тело письма html шаблон. Можно ли атрибуту .body присвоить значение шаблона, или из текстового файла вставить, или из шаблона письма создать объект и приравнять его .body к отсылаемому. Буду рад услышать советы.

[Pryanik88]

Кто нибудь отзовитесь!

[Iska]

Pryanik88, чтобы кто-нибудь отозвался — желательно было, чтобы в Вашем исходном вопросе были озвучены следующие сведения:
* исходный текст «код который делает рассылку»;
* какой именно «outlook», включая версию.

Гадать на кофейной гуще, вытягивать из Вас сведения клещами, приводить код, который затем надо будет десять раз править, потому что Вы не озвучили все исходные данные — желающих мало.

[Pryanik88]

Версия 2007, вопрос изложен, нужно вставить шаблон в текст письма, то есть атрибут .HTMLbody вместо .body
Сформулирую по другому - Как открыть html фаил сохраненный на компьютере, или же лучше ввести текст непосредственно в код.
Извиняюсь за неверно сформулированный вопрос.

[Pryanik88]

Вот что наколупал на данный момент, в 2007 работает, создаем кнопку и этот код:

'funkciya dlya otkrytiya texta.
Function GetBoiler(ByVal sFile As String) As String
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function

Private Sub CommandButton1_Click()

Dim sigstring As String
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim I As Integer
I = 1
sigstring = "C:\123.htm"

'vypolnyaem cycl dlya vseh nepustyh poley
Do Until (Cells(I, 1).Value = "")


'otkryvaem outlook i sozdaem pis'mo
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)




'zapolnyaem pismo dannymi i otsylaem
With OutMail
.To = Cells(I, 2).Value
.Subject = Cells(I, 3).Value
.HTMLBody = GetBoiler(sigstring)
.Attachments.Add Cells(I, 5).Value
.Send
End With

On Error GoTo 0
Set OutMail = Nothing
I = I + 1
Loop


End Sub