Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  

Показать сообщение отдельно

Новый участник


Сообщения: 4
Благодарности: 0

Профиль | Отправить PM | Цитировать


Вот что наколупал на данный момент, в 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

Отправлено: 21:35, 09-08-2011 | #5