** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Access y VBA > Access y VBA
  Mensajes nuevos Mensajes nuevos RSS - Envío Correo CDO
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Envío Correo CDO

 Responder Responder
Autor
Mensaje
Mkchis Ver desplegable
Nuevo
Nuevo


Unido: 28/Febrero/2011
Estado: Sin conexión
Puntos: 10
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita Mkchis Cita  ResponderRespuesta Enlace directo a este mensaje Tema: Envío Correo CDO
    Enviado: 15/Febrero/2021 a las 12:04
Buenos días, tengo el siguiente código de Buho en un módulo para la Función EnviaCorreo....
Function EnviaCorreo(StrPara As String, StrDe As String, _
                          StrAsunto As String, StrCuerpo As String, StrRutaAdjunto As String, _
                          Optional IntFormato As Integer = 1)
    Dim ObjetoMensajeLibre As Object, strHTML As String

    'Enviando Correo utilizando autentificación remota del server
    ' Creamos el objeto.
    On Error GoTo EnviaCorreoLibre_Err
    Set ObjetoMensajeLibre = CreateObject("CDO.Message")

    ' A quien va el mensaje. Para multimples destinos, separa las direcciones de correo por «;»
    ObjetoMensajeLibre.To = StrPara

    ' Aquí va el asunto
    ObjetoMensajeLibre.Subject = StrAsunto

    'Quien envía el correo. ! ojo ! solo funciona con esta sitaxis:
    ' Nombre <tucuenta@tuservidor.com>
    'es decir, por ejemplo: Francisco Javier garcía Aguado<paco@nemo.es>
    'Ojo al dato pues
    ' OJO  OJO  OJO  OJO :
    ObjetoMensajeLibre.From = StrDe
    'se rechaza si no se recibe una cadena tipo <algo@algo.es>

    Select Case IntFormato

    Case 1
        'Aqui va el cuerpo sin formato
        ObjetoMensajeLibre.TextBody = StrCuerpo
    Case 2
        ' Si quieres formato HTML:
        ' Formato HTML en el cuerpo del mensaje.
        strHTML = "<HTML>"
        strHTML = strHTML & "<HEAD>"
        strHTML = strHTML & "<BODY>"
        strHTML = strHTML & _
                  Replace(StrCuerpo, vbCr, "<Br>") & "</br>"
                  '"<b>" & Replace(StrCuerpo, vbCr, "<Br>") & "</b></br>"
        strHTML = strHTML & "</BODY>"
        strHTML = strHTML & "</HTML>"
        ObjetoMensajeLibre.HTMLBody = strHTML
    Case Else
        ObjetoMensajeLibre.TextBody = StrCuerpo
    End Select

    ' Para fichero adjunto:
    If Len(StrRutaAdjunto) <> 0 Then
        ObjetoMensajeLibre.addattachment ("file://" & StrRutaAdjunto)
    End If


    '****************************************************
    'Aqui comienza en si las configuraciones del server de correo remoto
    ' ****************************************************
    ObjetoMensajeLibre.Configuration.Fields.Item( _
            "http://schemas.microsoft.com/cdo/configuration/sendusing") = _
            ConstanteCDOPuerto

    '  Aquí puedes poner, bien el literal, bien la IP
    'de la maquina remota del server.

    ObjetoMensajeLibre.Configuration.Fields.Item( _
            "http://schemas.microsoft.com/cdo/configuration/smtpserver") = _
            StrServer    ' recuerda, _
                         es tu servidor de correo...lo puedes ver en las configuraciones
    '  de tu gestor de correo

    'Ahora especificamos el tipo de autentificacion que el server espera:

    ObjetoMensajeLibre.Configuration.Fields.Item( _
            "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = _
            ConstanteCDOA_Basica

    ' Aquí el nombre de usuario que el sever espera recibir(Lo puedes ver en las configuraciones
    'de las cuentas de Outlook y Outlook  Express:

    ObjetoMensajeLibre.Configuration.Fields.Item( _
            "http://schemas.microsoft.com/cdo/configuration/sendusername") = _
            StrUsuario

    ' Aquí el password (Contraseña) del usuario (Tambien la sacas de la configuracion del OE & Outlook)

    ObjetoMensajeLibre.Configuration.Fields.Item( _
            "http://schemas.microsoft.com/cdo/configuration/sendpassword") = _
            StrPassword

    'Aqui el puerto. Casi siempre el 25.... asi que lo dejo a a piñon fijo
    ObjetoMensajeLibre.Configuration.Fields.Item( _
            "http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465

    'Si estas usando SSL para la conexión. Valores (False or True)
    ObjetoMensajeLibre.Configuration.Fields.Item( _
            "http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

    ' Tiempo en segundos para que se establezca correctamente el protocolo SMTP.
    ObjetoMensajeLibre.Configuration.Fields.Item( _
            "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

    ' Guardamos....
    ObjetoMensajeLibre.Configuration.Fields.Update

    ' Y ! POR FIN !  enviamos
    ObjetoMensajeLibre.Send
EnviaCorreoLibre_Exit:
    Exit Function
EnviaCorreoLibre_Err:
    MsgBox "Error nº " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
           "en procedimiento EnviaCorreoLibre de Módulo ModuloCdo", vbCritical, "Aviso de error"
    Resume EnviaCorreoLibre_Exit
End Function


Posteriormente en el botón del formulario que utilizo para enviar tengo el siguiente que llama a la función de enviar el correo automáticamente a cada registro de la tabla

Dim db As DAO.Database
Dim rs As Recordset

'CREAMOS LAS VARIABLES
Dim s As String, R1 As String, R2 As Strin

' activamos la BD
Set db = CurrentDb

' Creamos el Recordset:
s = Me.Id_TRA
Set rs = db.OpenRecordset("Select * from "tabla" where [ID] =" & s & "")

' Recorremos el recordset:
Do While Not rs.EOF

'ASIGNAMOS VALORES A LAS VARIABLES
R1 = rs("nombre1")
R2 = rs("nombre2")
  
'Este codigo es el que va en el comando 44
Dim rpt As Report
Dim varMiCarpetaPDF As String

'Indicamos la carpeta por defecto
varMiCarpetaPDF = "C:\xxxxx\"

'Aqui elegimos pate del nombre del pdf
Dim varNumeroFactura As String
varNumeroFactura = s

'Aqui gurdamos la ruta del archivo pdf
Dim varRutaAdjunto As String
varRutaAdjunto = "C:\xxxxx\"

'Aqui guardamos el nombre del archivo pdf
Dim varNombrePDF2 As String
varNombrePDF2 = varNumeroFactura & ".pdf"

'Aqui unimos la ruta del archivo y el nombre del pdf, POR LO TANTO YA TENEMOS LA RUTA Y EL NOMBRE DEL ARCHIVO para el adjunto
Dim varAdjunto As String
varAdjunto = varRutaAdjunto & "" & varNombrePDF2

Dim varRemitente As String
varRemitente = "xxx@xxx.com"


'Enviarmos el correo

EnviaCorreo rs("EMAIL"), varRemitente, _
     "Solicitud asutno:xxxxx", "Texto Mensaje", varAdjunto, 2
     
rs.MoveNext
Loop


Lo que me gustaría es que en lugar de enviar sólo 1 archivo adjunto, pudiera enviar tantos como variables R1, R2 tuviera en el registro.

¿Qué debería cambiar tanto en el primer código como en el segundo para que pueda enviar más de 1 adjunto?

Muchas gracias y perdón si la respuesta está ya contestada, pero no la he podido encontrar.

Un saludo.
Arriba
Mihura Ver desplegable
Administrador
Administrador
Avatar

Unido: 06/Mayo/2005
Localización: En la dehesa
Estado: Sin conexión
Puntos: 12337
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita Mihura Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 15/Febrero/2021 a las 12:33
El quid de tu pregunta está aquí:

    ' Para fichero adjunto:
    If Len(StrRutaAdjunto) <> 0 Then
        ObjetoMensajeLibre.addattachment ("file://" & StrRutaAdjunto)
    End If

Puedes adjuntar tantos objetos (.addattachment) como quieras, sólo te tienes que plantear como hacerlo:
- pasas en StrRutaAdjunto las distintas rutas (por ejemplo separadas por ; y aquí las separas con split) - cambias StrRutaAdjunto de String a Collection

Yo he empleado las dos maneras, me gusta más la segunda.


Jesús Mansilla Castells.
Saludos desde Móstoles.

Access Aplicaciones
Tecsys.es
Arriba
Mkchis Ver desplegable
Nuevo
Nuevo


Unido: 28/Febrero/2011
Estado: Sin conexión
Puntos: 10
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita Mkchis Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 15/Febrero/2021 a las 16:19
Publicado originalmente por Mihura Mihura escribió:

El quid de tu pregunta está aquí:

    ' Para fichero adjunto:
    If Len(StrRutaAdjunto) <> 0 Then
        ObjetoMensajeLibre.addattachment ("file://" & StrRutaAdjunto)
    End If

Puedes adjuntar tantos objetos (.addattachment) como quieras, sólo te tienes que plantear como hacerlo:
- pasas en StrRutaAdjunto las distintas rutas (por ejemplo separadas por ; y aquí las separas con split) - cambias StrRutaAdjunto de String a Collection

Yo he empleado las dos maneras, me gusta más la segunda.



Hola Mihura, gracias por la respuesta, la primera solución lo he intentado pero no lo he logrado. 

Si no te es molestia, ¿podrías poner el código de ambos ejemplos?.

Gracias, pero soy un poco torpe con ello.
Arriba
Mihura Ver desplegable
Administrador
Administrador
Avatar

Unido: 06/Mayo/2005
Localización: En la dehesa
Estado: Sin conexión
Puntos: 12337
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita Mihura Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 15/Febrero/2021 a las 16:41
¿Qué has intentado?  .. ponlo y lo discutimos / mejoramos


Jesús Mansilla Castells.
Saludos desde Móstoles.

Access Aplicaciones
Tecsys.es
Arriba
Mkchis Ver desplegable
Nuevo
Nuevo


Unido: 28/Febrero/2011
Estado: Sin conexión
Puntos: 10
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita Mkchis Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 15/Febrero/2021 a las 16:50
Publicado originalmente por Mihura Mihura escribió:

¿Qué has intentado?  .. ponlo y lo discutimos / mejoramos


Lo que he intentado, ya que no soy muy dado a la programación, es en el código del botón de envío (formulario Access, 2º código) es en la variable del Adjunto asignarle el valor directamente separados por ";".



VarAdjunto = "C:/1.pdf" & ";" & "C:/2.pdf"


Arriba
Mihura Ver desplegable
Administrador
Administrador
Avatar

Unido: 06/Mayo/2005
Localización: En la dehesa
Estado: Sin conexión
Puntos: 12337
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita Mihura Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 15/Febrero/2021 a las 17:01
... pues si no eres muy dado a la programación ...  Unhappy

Con lo que has hecho tienes una variable con el valor:

                 "C:/1.pdf;C:/2.pdf"

OK, correcto es un valor válido     (nota: tienes las barras al revés, deben ser \).

¿Y ahora qué?  ... la pista ya te la puse antes SPLIT


Jesús Mansilla Castells.
Saludos desde Móstoles.

Access Aplicaciones
Tecsys.es
Arriba
Mkchis Ver desplegable
Nuevo
Nuevo


Unido: 28/Febrero/2011
Estado: Sin conexión
Puntos: 10
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita Mkchis Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 15/Febrero/2021 a las 17:13
Gracias Mihura, pero como ya he comentado no sé programar. Sólo intentaba si alguien podría ponerme el código que me falta para poder realizar más de un envío.

Gracias de nuevo.
Arriba
Mihura Ver desplegable
Administrador
Administrador
Avatar

Unido: 06/Mayo/2005
Localización: En la dehesa
Estado: Sin conexión
Puntos: 12337
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita Mihura Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 15/Febrero/2021 a las 17:16
Pues llevas 10 años en este foro, ya debes saber que ese no es el espíritu del mismo. Las soluciones Adhoc en Facebook, LWP, TodoExpertos ....

Un saludo.

Jesús Mansilla Castells.
Saludos desde Móstoles.

Access Aplicaciones
Tecsys.es
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable