CODEWITHSUNDEEP
vb6outlook
Rupesh
Rupesh

Reputation: 761

Sending Multiple mails from outlook using VB6

Hi I am developing a small application in VB to send separate mails from a list of email addresses stored in an Access database. I am using ADODC controller to connect VB and Access. But while looping through ADODC controller I am getting the error "Item has been moved or deleted". could you guys please help me on this? Below is the code I am using. I want to send separate mail for each address, so cant use .Recipients.Add command.

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

Upvotes: 1

Views: 4772

Answers (2)

Tamer Alahmad
Tamer Alahmad

Reputation: 11

Your code was correct, all you needed is to put the with inside the loop not the opposit

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

Upvotes: 1

virusrocks
virusrocks

Reputation: 871

.Send will send the email. In the first iteration email will be sent and the oOMail will be lost. After the first loop you will start getting the error you mentioned.

Edit----------------------

Sorry for not rewriting the code earlier. Assuming that you have to add all the attachments in a single email and than send it

Edit--------------------------------------

In case you want to create the email object each time

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

end sub

Upvotes: 4

Related Questions