我正在开发一个向多个电子邮件地址发送电子邮件的程序。问题是,当我发送消息时,每个邮件地址都会收到多条消息。如果我有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
答案 0 :(得分:0)
您可以使用以下概念使用VBA进行此操作。
在Sheets(“Sheet1”)中创建一个列表:
在A栏中:人物的名字在B栏中:电子邮件地址在C栏中:Z:像这样的文件名C:\ 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