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

从Excel发送大量电子邮件

1 个答案: