☰

发送 Excel 数据

tag-icon • tag-icon microsoft-excel
发送 Excel 数据

我想向很多用户发送一封电子邮件，并在其中附加一些不能发送给其他人的个人数据，例如密码。

用户和个人数据按 Excel 文件的列进行组织。

我想根据该文件自动向每个用户发送一封电子邮件，即每行一条消息，并使用特定的消息模板。

在 Excel 菜单上，我找不到这样的选项...

有什么帮助吗？

例如：

Data.xls

Recipient   Password
[email protected] fjsdjg
[email protected] kjasdh
[email protected] laldwk
[email protected] kdfljf

电子邮件正文模板：

Hello friends!

I created a survey on Google Docs named "XXX", with the
following link: http://XXX

To avoid double submitting or answers from people out of
our group, I created a password below for you. Please,
enter that on related field to validate your form.

######

Bye,
Me

答案1

最好的方法是使用 Microsoft Word 中邮件选项卡下的“邮件合并”功能。这将允许您向电子表格中列出的电子邮件地址发送消息，因为它让您可以选择要从中提取信息进行邮件合并的电子表格。

答案2

您也可以使用 Microsoft Outlook 从 VBA 执行此操作（或者您可以将代码中的 SendEmail 函数替换为您想要的任何其他邮件发送实现）。只需打开“开发人员”选项卡、Visual Basic，然后将其放入 ThisWorkbook 模块中。

Option Explicit

Public Mail_Object As Object

Sub SU_458659()
    Dim numofrows As Integer
    Dim i As Integer
    Dim ws As Worksheet
    Dim startRow As Integer
    Dim emailColumn As Integer
    Dim passwordColumn As Integer

    'TWEAKABLE: Change this to the first row to process
    startRow = 2 'Assuming row 1 is header

    'TWEAKABLE: Change ActiveSheet to a sheet name, etc. if you don't want it to run on the currently "active" (selected) sheet
    Set ws = ActiveSheet

    'TWEAKABLE: Change this to the row number ("A" is 1) of the email address
    emailColumn = 1

    'TWEAKABLE: Change this to the row number ("B" is 2) of the password field
    passwordColumn = 2

    'Get the number of rows in the sheet
    numofrows = ws.Range("A1").Offset(ws.Rows.Count - 1, 0).End(xlUp).Row

    'Shouldn't have to tweak anything in here
    For i = startRow To numofrows
        Dim emailCell As Range
        Dim passwordCell As Range
        Set emailCell = ws.Cells(i, emailColumn)
        Set passwordCell = ws.Cells(i, passwordColumn)
        If Not IsEmpty(emailCell) Then
            Dim email As String
            Dim password As String
            email = CStr(emailCell.Value)
            password = CStr(passwordCell.Value)
            SendEmail email, password
        End If
    Next i
End Sub

Sub SendEmail(email As String, password As String)
    Dim emailSubject As String
    Dim emailSendFrom As String
    Dim emailCc As String
    Dim emailBcc As String
    Dim prePassword As String
    Dim postPassword As String
    Dim Mail_Single As Variant

    If Mail_Object Is Nothing Then Set Mail_Object = CreateObject("Outlook.Application")

    'TWEAKABLE: Email subject
    emailSubject = "CHANGE THIS"

    'TWEAKABLE: The 'from' email address
    emailSendFrom = "[email protected]"

    'TWEAKABLE: The CC: field (just make it the empty string "" if you don't want a CC
    emailCc = "[email protected]"

    'TWEAKABLE: The BCC: field (just make it the empty string "" if you don't want a BCC)
    emailBcc = "[email protected]"

    'TWEAKABLE: The email body BEFORE the password
    prePassword = "Your password is: """

    'TWEAKABLE: The email body AFTER the password - vbCrLf is a newline like hitting Enter
    postPassword = """." & vbCrLf & vbCrLf & "Have fun!"

    On Error GoTo debugs
    Set Mail_Single = Mail_Object.CreateItem(0)
    With Mail_Single
    .Subject = emailSubject
    .To = email
    .cc = emailCc
    .BCC = emailBcc
    .Body = prePassword & password & postPassword

    'TWEAKABLE: Remove the following three lines before ".send" to remove message box confirmation
    Dim retval As Variant
    retval = MsgBox("Do you want to send an email to " & email & " with the password " & password & "?", vbYesNo, "Confirmation")
    If retval = vbNo Then Exit Sub

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

相关内容