Я попытался создать электронные письма на основе данных из электронной таблицы Excel и сохранить их на своем компьютере.
В электронной таблице данные выглядят следующим образом:
- столбец A: К которому mail
- столбец B: на какое письмо (cc)
- столбец C: тема
- столбец D: текст сообщения (путь на локальном компьютере к текстовому документу)
- столбец E: вложение 1 (путь к локальному компьютеру к любому соответствующему файлу вложения)
- Также можно добавить вложения в F, G и т.д. c.
Sub Mails()
Dim sh As Worksheet
Set sh = ActiveSheet
Dim OA As Object
Set OA = CreateObject("Outlook.Application")
Dim WA As Object
Set WA = CreateObject("Word.Application")
Dim msg As Object
Dim BodyText As Object
Dim i As Integer
Dim last_row As Integer
last_row = Application.WorksheetFunction.CountA(sh.Range("A:A"))
For i = 2 To last_row
Set msg = OA.createitem(0)
Set BodyText = msg.GetInspector.WordEditor
Set WordDoc = WA.documents.Open(Filename:=sh.Range("D" & i).Value, ReadOnly:=True)
WordDoc.Content.Copy
BodyText.Range.Paste
WordDoc.Close SaveChanges:=False
msg.To = sh.Range("A" & i).Value
msg.cc = sh.Range("B" & i).Value
msg.Subject = sh.Range("C" & i).Value
If sh.Range("E" & i).Value <> "" Then
msg.attachments.Add sh.Range("E" & i).Value
End If
'If sh.Range("F" & i).Value <> "" Then
'msg.attachments.Add sh.Range("F" & i).Value
'End If
'msg.Display
'msg.Send
msg.SaveAs "C:\Users\name\" & msg.Subject & ".msg", 3
Next i
End Sub
Сегодня он работал без проблем, затем я перезапустил свой компьютер, и теперь он выдает следующую ошибку:
введите описание изображения здесь
В строке: «Set BodyText = msg.GetInspector.WordEditor».
Кто-нибудь может заметить ошибку?