Новый участник
Сообщения: 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
|