** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Otros de Microsoft: Windows y Office > Excel
  Mensajes nuevos Mensajes nuevos RSS - Enviar Mail desde Excel .CDO
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoEnviar Mail desde Excel .CDO

 Responder Responder
Autor
Mensaje
Xantus Ver desplegable
Habitual
Habitual


Unido: 07/Febrero/2019
Localización: Málaga
Estado: Sin conexión
Puntos: 62
Enlace directo a este mensaje Tema: Enviar Mail desde Excel .CDO
    Enviado: 19/Octubre/2019 a las 19:39
Buenas tardes!

Tengo una hoja excel que saca datos de una aplicación con una macro.
Tengo una columna con oficinas (Empieza en A4) y otra con informes, además de cada oficina se ha creado un archivo con ese mismo nombre en pdf, por poner una ubicación y oficina aleatoria, estarían en C:/Informes/3240.pdf

Lo que necesito es enviar un correo a cada una de esas oficinas de la lista en la columna A enviandoles el fichero correspondiente de la carpeta, empezando por la primera hasta la última (que cada vez que saque los datos con la macro inicial se modifica todo). 
Los correos tendrian el mismo asunto y el mismo cuerpo de correo, lo que varía es la dirección a donde se envían y el fichero que se envía.

Alguien me echa una mano a terminar el código?

Private Sub SendMail()

    
    asunto = "ASUNTO DE CORREO"
    
    
    texto = "Buenos días," & vbCr & vbCr + _
            "Texto de Correo:" & _
            vbCr & vbCr + "Texto de Correo" & _
            vbCr & vbCr + "Texto de Correo" & _
            vbCr & vbCr + "Texto de Correo" & _
            vbCr & vbCr + "Texto de Correo" & _
            vbCr & vbCr + "Texto de Correo" & _
            vbCr & vbCr + "<b>Texto de correo" & _
            vbCr & vbCr + vbCr & "Gracias, " & _
            vbCr & vbCr + vbCr & "Un saludo. " 'MsgBox texto
            
    
    If IsNull(Usuario) Then
        MsgBox "No existe Email de Usuario para la oficina: Oficina"
        GoTo Exit_CORREO_Click::
    End If
    
    Set miCorreo = CreateObject("CDO.Message")

    With miCorreo
        
          '.from = "mi correo" & "< >"
          
          .from = "mi correo" & "<mi correo>"
        '.from = "mi correo"
        '.To = "mi correo"
        .To = "destinatario"
        .Bcc = "mi correo"
        .replyto = "mi correo"
        
        .Subject = asunto
        .TextBody = texto
.ObjetoCDO.addAttachment ("file://" & C:/Informe/"Oficina" & .pdf)
        .Configuration.Fields.Item _
        ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Configuration.Fields.Item _
        ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _
        "smtpbbva"
        .Configuration.Fields.Item _
        ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Configuration.Fields.Update
        '.display
        .Send
    End With
    
    Set miCorreo = Nothing
    
    
Exit_CORREO_Click:
    Exit Sub

Err_CORREO_Click:
    MsgBox Err.Description
    Resume Exit_CORREO_Click
End Sub



Mil gracias de antemano!

Un saludo.
Arriba
AnSanVal Ver desplegable
Administrador
Administrador
Avatar

Unido: 16/Marzo/2005
Localización: España
Estado: Sin conexión
Puntos: 5970
Enlace directo a este mensaje Enviado: 21/Octubre/2019 a las 11:58
Lo que planteas no es una duda.

Lo que buscas es que alguien te termine el código. Ouch

Eso incumple las Normas del foro, salvo que lo plantees en este otro...

http://www.mvp-access.com/foro/para-empresas-contrate-aqu-profesionales_forum21.html

Saludos desde Tenerife.
Arriba
xavi Ver desplegable
Administrador
Administrador
Avatar
Terrassa-BCN

Unido: 10/Mayo/2005
Localización: Catalunya ||||
Estado: Sin conexión
Puntos: 14720
Enlace directo a este mensaje Enviado: 21/Octubre/2019 a las 13:54
Hola,

Yo no te voy a dar el código. Simplemente te diré los pasos a seguir para que tu seas capaz de hacerlo por tu cuenta. Aquí miramos de enseñar a pescar, no dar peces.


Primero modificas el encabezado del procedimiento para que acepte los argumentos "Para" y "RutaAdjunto". Modificas el procedimiento para que utilice esos argumentos.

Por otro lado te creas un bucle por las oficinas e informes. 
En cada iteración:

- Creas la ruta al fichero.
- Obtienes la dirección de correo
- Lanzas el procedimiento con los argumentos adecuados.

Un saludo
Xavi, un minyó de Terrassa

Mi web
Arriba
Xantus Ver desplegable
Habitual
Habitual


Unido: 07/Febrero/2019
Localización: Málaga
Estado: Sin conexión
Puntos: 62
Enlace directo a este mensaje Enviado: 21/Octubre/2019 a las 18:32
Buenas tardes.
No deseo entrar en disputas, esto es un foro de ayuda y es lo que buscaba, honestamente me he sentido ofendido cuando pretendeis decir que quiero que me hagáis algo y me sugerís que lo contrate.
Esto no es para ninguna empresa ni trabajo, lo hago gratuitamente y para ayudar a una organización sin ánimo de lucro. 
Ni son oficinas ni se envía nada, son nombres y apellidos y direcciones de correo.

Dicho esto, y no haciendo caso de vuestras respuestas, os dejo la explicación y código:

Finalmente, y para poder enviarlo he concatenado en el excel toda la columna de oficinas "desde A4 hasta A500" para que en las columnas 15,16 y 17 queden la oficina, la dirección de email y la dirección de la carpeta de windows con el nombre del archivo.

El código:

Dim MiCorreo As CDO.Message

For Each Celda In ThisWorkbook.Sheets("Hoja1").Range("A4:A500")
    
    Oficina = Celda.Offset(0, 15).Value
    
    If Oficina Is False Then
'Se envía el correo
    Else

        Set MiCorreo = New CDO.Message
       

        Asunto = "Asunto de Correo"
        Destinatario = Celda.Offset(0, 1).Value
        Adjunto = Celda.Offset(0, 1).Value
        '
        'Cuerpo del mensaje
        '
        Msg = "Buenos días" & vbNewLine & vbNewLine
        Msg = Msg & "Cuerpo de correo "
        Msg = Msg & "Cuerpo de correo"" & vbNewLine & vbNewLine"
        Msg = Msg & "Cuerpo de Correo"
        Msg = Msg & "Un saludo" & vbNewLine
        Msg = Msg & "Xantus"
        '
        With MiCorreo
            .Subject = Asunto
            .From = "mi correo gmail"
            .To = Destinatario
            '.CC = "Mi correo"
            '.BCC = "Mi correo"
     .replyto = "Mi correo"
            .TextBody = Msg
            .AddAttachment Adjunto
        End With
        '
        MiCorreo.Send
        'MsgBox "El correo ha sido enviado."
        '
        Set MiCorreo = Nothing

    End If
'
Next Celda

MsgBox "Correos enviados", vbInformation, "Xantus"
        
End Sub

---------------------------

Cuando tenga finalizado el código y compruebe que funciona correctamente, volveré a este hilo (que rogaria no me cerreis), para subir el código definitivo y las fórmulas utilizadas en el excel.

Un saludo.
Xantus.
Arriba
javier.mil Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 10/Agosto/2005
Localización: España
Estado: Sin conexión
Puntos: 4812
Enlace directo a este mensaje Enviado: 22/Octubre/2019 a las 00:54
Pégale un vistazo a la DEMO 47 de  http://www.accessdemo.info/   por si te puede servir....

 



Editado por javier.mil - 22/Octubre/2019 a las 19:00
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable