您好我正在VB中开发一个小应用程序,以便从存储在Access数据库中的电子邮件地址列表中发送单独的邮件。我正在使用ADODC控制器连接VB和Access。但是在循环通过ADODC控制器时,我收到错误“项已被移动或删除”。你能帮助我吗?以下是我正在使用的代码。我想为每个地址发送单独的邮件,因此无法使用.Recipients.Add
命令。
Private Sub Send_Click()
Dim oOApp As Outlook.Application
Dim oOMail As Outlook.MailItem
Set oOApp = CreateObject("Outlook.Application")
Set oOMail = oOApp.CreateItem(olMailItem)
With oOMail
Adodc1.Recordset.MoveFirst
While Adodc1.Recordset.EOF = False
.To = Text1.Text <------ getting error in this line in second iteration
.Subject = Subject.Text
.Body = MsgBody.Text
If path1.Text <> "" Then
.Attachments.Add path1.Text, olByValue, 1
End If
.Send
Adodc1.Recordset.MoveNext
Wend
End Sub
答案 0 :(得分:4)
。发送将发送电子邮件。在第一次迭代中,将发送电子邮件并且oOMail将丢失。在第一个循环之后,您将开始收到您提到的错误。
编辑----------------------
很抱歉没有提前重写代码。假设您必须在一封电子邮件中添加所有附件而不是发送
编辑--------------------------------------
如果您想每次都创建电子邮件对象
Private Sub Send_Click()
Dim oOApp As Outlook.Application
Dim oOMail As Outlook.MailItem
Set oOApp = CreateObject("Outlook.Application")
Adodc1.Recordset.MoveFirst
While Adodc1.Recordset.EOF = False
Set oOMail = oOApp.CreateItem(olMailItem)
With oOMail
.To = Text1.Text <------ getting error in this line in second iteration
.Subject = Subject.Text
.Body = MsgBody.Text
If path1.Text <> "" Then
.Attachments.Add path1.Text, olByValue, 1
End If
Adodc1.Recordset.MoveNext
Wend
.Send 'Sending the email in the end
结束子
答案 1 :(得分:1)
你的代码是正确的,你需要的只是把圈子放在循环中而不是对立
Private Sub Send_Click()
Dim oOApp As Outlook.Application
Dim oOMail As Outlook.MailItem
Set oOApp = CreateObject("Outlook.Application")
Set oOMail = oOApp.CreateItem(olMailItem)
Adodc1.Recordset.MoveFirst
While Adodc1.Recordset.EOF = False
With oOMail
.To = Text1.Text
.Subject = Subject.Text
.Body = MsgBody.Text
If path1.Text <> "" Then
.Attachments.Add path1.Text, olByValue, 1
End If
.save
.send
End with.
Adodc1.Recordset.MoveNext
Wend
End sub