VB6을 사용하여 Outlook에서 여러 메일 보내기

Question

안녕하세요. VB의 작은 응용 프로그램을 개발하여 Access 데이터베이스에 저장된 전자 메일 주소 목록에서 개별 메일을 보내고 있습니다. VB와 Access에 연결하기 위해 ADODC 컨트롤러를 사용하고 있습니다. 하지만 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 

Answer 1

. 보내 주시면 이메일을 보내 드리겠습니다. 첫 번째 반복에서 전자 메일이 전송되고 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 

최종 서브

Answer 2

귀하의 코드가 정확했다, 당신이 필요한 모든이를 넣을 때마다 만들려면 루프 내부는 반대가 아니다.

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