Enviar Mail desde Excel .CDO
Impreso de: Foro de Access y VBA
Categoría: Otros de Microsoft: Windows y Office
Nombre del foro: Excel
Descripción del foro: Foro de Excel y VBA de Excel
URL: http://www.mvp-access.com/foro/forum_posts.asp?TID=84764
Fecha de impresión: 19/Abril/2024 a las 11:58
Tema: Enviar Mail desde Excel .CDO
Publicado por: Xantus
Asunto: Enviar Mail desde Excel .CDO
Fecha de publicación: 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.
|
Respuestas:
Publicado por: AnSanVal
Fecha de publicación: 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.  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. |
Publicado por: xavi
Fecha de publicación: 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 http://www.llodax.com" rel="nofollow - Mi web 
|
Publicado por: Xantus
Fecha de publicación: 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.
|
Publicado por: javier.mil
Fecha de publicación: 22/Octubre/2019 a las 00:54
|
Pégale un vistazo a la DEMO 47 de http://www.accessdemo.info/" rel="nofollow - http://www.accessdemo.info/ por si te puede servir.... ------------- https://www.accessdemo.info" rel="nofollow - https://www.accessdemo.info |