使用VB6从outlook发送多封邮件

时间:2012-08-13 17:07:50

标签: vb6 outlook

您好我正在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

2 个答案:

答案 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