Привет, ребята. У меня проблема с отправкой нескольких электронных писем с одним и тем же шаблоном файла слова, текст сообщения которого я копирую из шаблона файла слова.Вот мой код
Sub emailsendout()
On Error GoTo Endnow
Application.ScreenUpdating = False
Dim WordDoc As Object
Dim WordFile As String
WordFile = Cells(1, 1).Value '<===word file path store at cell(1,1)
Set WordDoc = GetObject(WordFile)
Dim OutApp As Object, OutMail As Object, OutWordEditor As Object
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
Dim cell As Range
For Each cell In Columns("C").Cells.SpecialCells(xlCellTypeConstants)
If LCase(Cells(cell.Row, "B").Value) = "y" Then '<==create email if yes
Set OutMail = OutApp.CreateItem(0)
Set OutWordEditor = OutMail.GetInspector.WordEditor
On Error Resume Next
With OutMail
.To = cell.Value
.cc = cell.Offset(, 2)
.Subject = Cells(cell.Row, "G").Value
.Body = Cells(cell.Row, "F").Value '<===e.g.: Dear Mr.A
Set editor = .GetInspector.WordEditor
editor.Content.Paste
Set WordDoc = GetObject(WordFile)
WordDoc.Content.Copy
OutWordEditor.Content.Paste
OutWordEditor.Range(0).InsertBefore (Cells(cell.Row, "F").Value & vbCrLf & vbCrLf) '<==copy and paste word content after Dear Mr.A
WordDoc.Close
.Attachments.Add (Cells(cell.Row, "H").Text)
.Attachments.Add (Cells(cell.Row, "I").Text)
.Save
'.Send '<===problem is here
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
Endnow:
Когда я создаю электронное письмо как черновик, текстовая копия из шаблона слова отлично.но если я изменю команду с .Save на .Send и отправлю несколько электронных писем напрямую без сохранения черновика.Весь контент письма исчезает ....
Может кто-нибудь сказать мне проблему с ним?