Excel VBA для отправки почты через outlook

Question

Мне нужен код Excel VBA, который при запуске должен запрашивать ячейки, содержащие идентификатор электронной почты (TO, Cc и Bcc), а затем запрашивать ячейки, значение которых должно быть телом почты в outlook.

Может кто-нибудь помочь мне, любая помощь очень ценится.

Спасибо

Answer 1

Следующие данные помогут вам получить желаемые результаты, и вам будет предложено выбрать диапазон / ячейку для To, CC, BCC, Subject & Email Body:

Sub SendEmail()

Set EmailTo = Application.InputBox(Prompt:="Please Select To", Title:="Range Select", Type:=8)
Set EmailCC = Application.InputBox(Prompt:="Please Select CC", Title:="Range Select", Type:=8)
Set EmailBCC = Application.InputBox(Prompt:="Please Select BCC", Title:="Range Select", Type:=8)
Set EmailSubject = Application.InputBox(Prompt:="Please Select Subject", Title:="Range Select", Type:=8)
Set EmailBody = Application.InputBox(Prompt:="Please Select Body", Title:="Range Select", Type:=8)

Dim OutApp As Object: Set OutApp = CreateObject("Outlook.Application")
Dim OutMail As Object: Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
    .to = EmailTo.Value
    .CC = EmailCC.Value
    .BCC = EmailBCC.Value
    .Subject = EmailSubject.Value
    .HTMLBody = EmailBody.Value
    .Display '.Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

ОБНОВЛЕНИЕ:

Следующее разделит несколько ячеек для тела письма:

Sub SendEmail()
Dim c As Range, EmailTo As Range, EmailCC As Range, EmailSubject As Range, EmailBody As Range

Set EmailTo = Application.InputBox(Prompt:="Please Select To", Title:="Range Select", Type:=8)
Set EmailCC = Application.InputBox(Prompt:="Please Select CC", Title:="Range Select", Type:=8)
Set EmailBCC = Application.InputBox(Prompt:="Please Select BCC", Title:="Range Select", Type:=8)
Set EmailSubject = Application.InputBox(Prompt:="Please Select Subject", Title:="Range Select", Type:=8)
Set EmailBody = Application.InputBox(Prompt:="Please Select Body", Title:="Range Select", Type:=8)

For Each c In EmailBody
    BodyString = BodyString & "<br>" & c
    'Added <br> to separate each cell into a new line on the HTML email.
Next c

Dim OutApp As Object: Set OutApp = CreateObject("Outlook.Application")
Dim OutMail As Object: Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
    .to = EmailTo.Value
    .CC = EmailCC.Value
    .BCC = EmailBCC.Value
    .Subject = EmailSubject.Value
    .HTMLBody = BodyString
    .Display '.Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub