Enviar e-mail a varias personas desde access a outlook (NO LO CONSIGO AYUDA POR FAVOR)
Publicado por Javier (71 intervenciones) el 31/03/2016 18:17:54
Hola programadores, escribo porque ya estoy desesperado, tengo una base de datos con varios formularios y uno de ellos es para enviar e-mail abriendo outlook como intermediario, para enviarlo a una persona lo hago bien, este es el código que SI me funciona para una persona:
ESTE CÓDIGO FUNCIONA PERFECTAMENTE, ME ABRE EL OUTLOOK CON EL DESTINATARIO YA PUESTO Y LOS ARCHIVOS ADJUNTOS DEL FORMULARIO AGREGADOS
EL PROBLEMA VIENE CUANDO QUIERO ENVIARLO A TODOS LOS DESTINATARIOS DONDE USO EL SIGUIENTE CÓDIGO:
ESTE CÓDIGO ME ABRE EL OUTLOOK , ME AGREGA LOS ARCHIVOS ADJUNTOS, PERO NO ME AGREGA A NADIE COMO DESTINATARIO ALGUIEN SABE DONDE ESTÁ EL FALLO?
ESPERO QUE ME PODÁIS AYUDAR ESTOY DESESPERADO
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Private Sub Comando16_Click()
Call sendmail
End Sub
Sub sendmail()
Dim oOutlook As Outlook.Application
Dim oEmailItem As MailItem
On Error Resume Next
Err.Clear
Set oOutlook = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Set oOutlook = New Outlook.Application
End If
Set oEmailItem = oOutlook.CreateItem(olMailItem)
With oEmailItem
.To = Me.CORREO_ELECTRÓNICO
.CC = ""
.Subject = "CORREO DE ACADEMIA"
For n = 0 To Me.Lista14.ListCount - 1
.Attachments.Add (Me.Lista14.ItemData(n))
Next n
.Display
End With
Set oEmailItem = Nothing
Set oOutlook = Nothing
End Sub
ESTE CÓDIGO FUNCIONA PERFECTAMENTE, ME ABRE EL OUTLOOK CON EL DESTINATARIO YA PUESTO Y LOS ARCHIVOS ADJUNTOS DEL FORMULARIO AGREGADOS
EL PROBLEMA VIENE CUANDO QUIERO ENVIARLO A TODOS LOS DESTINATARIOS DONDE USO EL SIGUIENTE CÓDIGO:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Private Sub Comando18_Click()
Dim oOutlook As Outlook.Application
Dim oEmailItem As MailItem
Dim rs As Recordset
Dim customerEmail As String
On Error Resume Next
Err.Clear
Set oOutlook = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Set oOutlook = New Outlook.Application
End If
Set oEmailItem = oOutlook.CreateItem(olMailItem)
With oEmailItem
Set rs = CurrentDb.OpenRecordset("Select * from ALUMNOS")
If rs.RecordCount > 0 Then
rs.MoveFirst
Do Until rs.EOF
If IsNull(rs!CORREO_ELECTRÓNICO) Then
rs.MoveNext
Else
customerEmail = customerEmail & rs!CORREO_ELECTRÓNICO & ";"
.To = customerEmail
rs.MoveNext
End If
Loop
Else
MsgBox " NADIE TIENE EMAIL"
End If
Set rs = Nothing
.CC = ""
.Subject = "PRUEBA"
For n = 0 To Me.Lista14.ListCount - 1
.Attachments.Add (Me.Lista14.ItemData(n))
Next n
.Display
End With
Set oEmailItem = Nothing
Set oOutlook = Nothing
End Sub
ESTE CÓDIGO ME ABRE EL OUTLOOK , ME AGREGA LOS ARCHIVOS ADJUNTOS, PERO NO ME AGREGA A NADIE COMO DESTINATARIO ALGUIEN SABE DONDE ESTÁ EL FALLO?
ESPERO QUE ME PODÁIS AYUDAR ESTOY DESESPERADO
Valora esta pregunta
0