多个电子邮件发送者 - 每个邮件地址收到的消息多于一条消息

Question

我正在研究一个程序，该程序将电子邮件发送到多个电子邮件地址。问题是，当我发送消息时，每个邮件地址收到的收到的消息多于一条消息。如果我有5个电子邮件地址，则该程序将向每个电子邮件地址发送5条消息。我该如何解决？这是我的代码：

Private Sub button1_Click(sender As Object, e As EventArgs) Handles button1.Click
    Dim trd As Threading.Thread
    trd = New Threading.Thread(AddressOf mailBomber)
    trd.isBackground = True
    trd.Start()
End Sub
Private Function mailBomber()
    Dim sent As Integer = 0
    Dim toSend As Integer = 5
    Do Until sent >= toSend
        Try
            Dim SmtpServer As New SmtpClient()
            Dim mail As New MailMessage()
            SmtpServer.Credentials = New Net.NetworkCredential(emailFrom.Text, emailPass.Text)
            SmtpServer.EnableSsl = True
            SmtpServer.Port = 587
            SmtpServer.Host = "smtp.gmail.com"
            mail = New MailMessage()
            mail.From = New MailAddress(emailFrom.Text)
            mail.To.Add(emailTo.Text)
            mail.Subject = subject.Text
            mail.Body = msg.Text
            SmtpServer.Send(mail)
            sent += 1
        Catch ex As Exception
            MsgBox(ex.ToString)
        End Try
    Loop
End Function

Answer 1

您可以使用下面的概念使用VBA进行操作。

用：

在表格（" Sheet1"）中列出列表

在A列中：B列中的人的名称：c：z列中的电子邮件地址：像这样的文件名： data book2.xls（不必是excel文件）

宏将在" Sheet1"中的每一行循环，如果B列中有一个电子邮件地址，则C列中的文件名：Z中的文件名，它将创建一个带有此信息的邮件并发送。<<<<<<<<<<<</p>

Sub Send_Files()
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim cell As Range
    Dim FileCell As Range
    Dim rng As Range
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    Set sh = Sheets("Sheet1")
    Set OutApp = CreateObject("Outlook.Application")
    For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        'Enter the path/file names in the C:Z column in each row
        Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")
        If cell.Value Like "?*@?*.?*" And _
           Application.WorksheetFunction.CountA(rng) > 0 Then
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .to = cell.Value
                .Subject = "Testfile"
                .Body = "Hi " & cell.Offset(0, -1).Value
                For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                    If Trim(FileCell) <> "" Then
                        If Dir(FileCell.Value) <> "" Then
                            .Attachments.Add FileCell.Value
                        End If
                    End If
                Next FileCell
                .Send  'Or use .Display
            End With
            Set OutMail = Nothing
        End If
    Next cell
    Set OutApp = Nothing
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub