Отправка массовых писем из Excel

Question

У меня есть рабочая тетрадь с листами, такими как [данные 1, данные 2, данные 3, лист 1, лист 2, лист 3 ... лист 20].Данные 1-3 листа являются источниками данных.лист 1-20 - это шаблоны листов, которые используют эти источники данных для генерации «отчетов».
Чего я хочу добиться, так это отправлять все эти отчеты сразу из Excel, не экспортируя их в растровое изображение, а затем копируя их по электронной почте.На листе данных 1 есть все электронные письма, соответствующие каждому листу, например:
лист 1 ----- имя ----- электронная почта
лист 2 ----- имя ----- электронная почта
.
.
.
лист 20 ----- имя ----- электронная почта

Вот псевдокод того, чего я пытаюсь достичь (этоэто лучший способ понять вещи)

for sheets 1-20:
    create tmp_email(object)
    tmp_email.subject = name+" report" #this name is from the data 1, the corresponding name for this sheet
    text_1 = "dear "+name+", here is your report"
    report_img = img_export($A$1:$P$149) #this is the area in all the template sheets that is exported into bitmap image
    text_2 = "best regards"
    tmp_email.body = text_1 + report_img + text_2
    tmp_email.send(email) #this email is from the data 1, the corresponding email for this sheet

Надеюсь, это имеет смысл.Поэтому все, что мне нужно сделать, - это построить свои листы 1 - 20, которые автоматически генерируются, а затем автоматически отправляются.

Answer 1

Вот три способа отправить электронное письмо через outlook (протестированные работы 11.29.18) (никаких всплывающих окон электронной почты в фоновом режиме не производится)

Отправить через CDO:

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Sub Send_Email_Using_CDO()
Dim CDO_Mail_Object As Object
Dim CDO_Config As Object
Dim SMTP_Config As Variant
Dim Email_Subject, Email_Send_From, Email_Send_To, Email_Cc, Email_Bcc, Email_Body As String

Email_Subject = "Trying to send email using CDO"
Email_Send_From = "databison@gmail.com"
Email_Send_To = "databison@gmail.com"
Email_Cc = "databison@gmail.com"
Email_Bcc = "databison@gmail.com"
Email_Body = "Congratulations!!!! You have successfully sent an e-mail using CDO !!!!"

Set CDO_Mail_Object = CreateObject("CDO.Message")

On Error GoTo debugs
Set CDO_Config = CreateObject("CDO.Configuration")
        CDO_Config.Load -1
        Set SMTP_Config = CDO_Config.Fields
        With SMTP_Config
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            'Put your server name below
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "YOURSERVERNAME"
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
            .Update
        End With

With CDO_Mail_Object
    Set .Configuration = CDO_Config
End With

CDO_Mail_Object.Subject = Email_Subject
CDO_Mail_Object.From = Email_Send_From
CDO_Mail_Object.To = Email_Send_To
CDO_Mail_Object.TextBody = Email_Body
CDO_Mail_Object.cc = Email_Cc                      'Use if needed
CDO_Mail_Object.BCC = Email_Bcc                    'Use if needed
'CDO_Mail_Object.AddAttachment FileToAttach        'Use if needed
CDO_Mail_Object.send

debugs:
If Err.Description <> "" Then MsgBox Err.Description
End Sub

отправка через ключи:

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

'***********************************************************************
'~~~~~~~~~~~~~~~~~~CODE COURTESY :: WWW.OZGRID.COM~~~~~~~~~~~~~~~~~~~~~~
'***********************************************************************
Sub Send_Email_Using_Keys()
    Dim Mail_Object As String
    Dim Email_Subject, Email_Send_To, Email_Cc, Email_Bcc, Email_Body As String

    Email_Subject = "Trying to send email using Keys"
    Email_Send_To = "databison@gmail.com"
    Email_Cc = "databison@gmail.com"
    Email_Bcc = "databison@gmail.com"
    Email_Body = "Congratulations!!!! You have successfully sent an e-mail using Keys !!!!"

    Mail_Object = "mailto:" & Email_Send_To & "?subject=" & Email_Subject & "&body=" & Email_Body & "&cc=" & Email_Cc & "&bcc=" & Email_Bcc

    On Error GoTo debugs
    ShellExecute 0&, vbNullString, Mail_Object, vbNullString, vbNullString, vbNormalFocus

    Application.Wait (Now + TimeValue("0:00:02"))
    Application.SendKeys "%s"

debugs:
If Err.Description <> "" Then MsgBox Err.Description
End Sub

отправка через VBA:

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Sub Send_Email_Using_VBA()
Dim Email_Subject, Email_Send_From, Email_Send_To, Email_Cc, Email_Bcc, Email_Body As String
Dim Mail_Object, Mail_Single As Variant

Email_Subject = "Trying to send email using VBA"
Email_Send_From = "databison@gmail.com"
Email_Send_To = "databison@gmail.com"
Email_Cc = "databison@gmail.com"
Email_Bcc = "databison@gmail.com"
Email_Body = "Congratulations!!!! You have successfully sent an e-mail using VBA !!!!"

On Error GoTo debugs
Set Mail_Object = CreateObject("Outlook.Application")
Set Mail_Single = Mail_Object.CreateItem(0)
With Mail_Single
    .Subject = Email_Subject
    .To = Email_Send_To
    .cc = Email_Cc
    .BCC = Email_Bcc
    .Body = Email_Body
    .send
End With

debugs:
If Err.Description <> "" Then MsgBox Err.Description
End Sub

для отправки активногоРабочая тетрадь:

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

'***********TO SEND THE ACTIVE WORKBOOK************'
Sub Send_Active_Workbook_Using_VBA()
Dim Email_Send_To, Email_Subject  As String

Email_Subject = "Trying to send email with the workbook as attachment"
Email_Send_To = "databison@gmail.com"

ActiveWorkbook.SendMail Recipients:=Email_Send_To, Subject:=Email_Subject
End Sub

Создание кнопок для отправки писем:

Private Sub CommandButton1_Click()
Sheet1.Send_Email_Using_VBA
End Sub

Private Sub CommandButton2_Click()
Sheet1.Send_Email_Using_CDO
End Sub

Private Sub CommandButton3_Click()
Sheet1.Send_Email_Using_Keys
End Sub