Откройте почтовый шаблон в Excel через VBA и заполните шаблон данными Excel

Question

Мне нужна помощь с использованием Excel для заполнения почтового шаблона.Моя проблема сейчас заключается в том, как открыть шаблон с помощью макроса. Я написал это:

Sub OpenMail()

    Open "L:\Projekte\Abteilung\Projekt\Vorlage_deutsch" For Input As #1

End Sub

Запуск этого макроса выдает ошибку, которая говорит о том, что данные не могут быть найдены.Есть ли способ сохранить шаблон в Excel напрямую, вместо того, чтобы пытаться открыть его с компьютера?Также, если у вас есть идеи о том, как заполнить электронное письмо данными из моих строк в Excel, это было бы очень полезно!Спасибо !!

Answer 1

Вот пример кода для открытия почтового шаблона outlook.

Sub CreateMailInExcel()
Dim olApp As Object
Set olApp = Outlook.Application
Dim Msg As Outlook.MailItem
''Debug.Print (olApp.ProductCode)
Set Msg = olApp.CreateItemFromTemplate("D:\Test\untitled.oft")
Msg.Display
'Set Msg = Nothing
Set olApp = Nothing
End Sub

Расширение почтового шаблона outlook: .oft

Необходимо указать ссылку на библиотеку объектов Microsoft Outlook 15.0.

Answer 2

Ниже sub просто введите письмо с данными из ячеек Excel.Вы должны настроить коды для ваших нужд.

Option Explicit

Sub SendMail()
Dim sendTo As String
Dim strBody As String
Dim strSubject As String
Dim OutApp As Object
Dim OutMail As Object
Dim strMail as String

'Ad referrence ---> Microsoft Outlook 12.0 object library

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)

strMail = Range("A1")  ' Email address in A1 cell
strBody = Range("B1")  ' Subject text in B1 cell
strSubject = Range("C1") ' Message body in C1 cell

        With OutMail
            '.Attachments.Add ThisWorkbook.Path & "\TestFile.pdf"
            .To = strMail
            .Subject = strSubject 
            .HTMLBody = strBody
            .Display 'Show mail message.
            '.Send  'Direct send
        End With
'    Application.Wait (Now + TimeValue("0:00:02"))
'    Application.SendKeys "%s"

End Sub