UniversoExcelForo

Respuesta a consultas.
Fecha de creación: 09.Abril.2012

Fundadores: Wibly,Tyno,Servando,Sakkar,Rosendo2,RMaximo,Railar,Mcoronel,Ioyama,Igtelo,Hugotron,Drochar,Dedos,Alberto,Adolfo

No se puede subir archivos al foro, favor de hacerlo en servidor externo (Dropbox, Drive...) y dejan link. "Sin archivo no hay respuestas"

Favor de leer "Todos los temas" Click aquí.

No estás conectado. Conéctate o registrate

Ver el tema anterior Ver el tema siguiente Ir abajo  Mensaje [Página 1 de 1.]

joloco61


Hola amigos requiero de su ayuda, tengo una macro que me envía correo por gmail funciona bien pero solo puedo enviar a un destinatario pero requiero enviar copias y copias oculpas me podran ayudar o decir que comando me falta. anexo macro.


[ltr]Sub EnvioHojaporGmail()

'Definiciones para el correo
Dim Email As CDO.Message
Dim Remitente As String
Dim Pass As String
Dim Destinatario As String
Dim Asunto As String
Dim Cuerpo As String

'Definiciones para archivo
Dim RutaTemporal As String
Dim NombreTemporal As String
Dim RutaCompleta

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Creación del archivo temporal
RutaTemporal = Environ$("temp") & "\"
NombreTemporal = ActiveSheet.Name & ".pdf"
RutaCompleta = RutaTemporal & NombreTemporal

On Error GoTo Err

ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=RutaCompleta, _
quality:=xlQualityStandard, _
includedocproperties:=True, _
ignoreprintareas:=False, _
openafterpublish:=False

'Información para el correo
Set Email = New CDO.Message
Remitente = "correo1@gmail.com"
Pass = "Password"
Destinatario = "correo2@gmail.com"
Asunto = "Prueba"
Cuerpo = "Hola"


Email.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
Email.Configuration.Fields(cdoSendUsingMethod) = 2
With Email.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465)
.Item("http://schemas.microsoft.com/cdo/" & "configuration/smtpauthenticate") = Abs(1)
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Remitente
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Pass
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
End With

With Email
.To = Destinatario
.From = Remitente
.Subject = Asunto
.TextBody = Cuerpo
.AddAttachment RutaCompleta
.Configuration.Fields.Update
On Error Resume Next
.Send
End With

If Err.Number = 0 Then
MsgBox "El correo ha sido enviado con éxito", vbInformation, "Confirmación"
Else
MsgBox "Se produjo el siguiente error: " & vbNewLine & _
Err.Description, vbCritical, "Error No. " & Err.Number
End If

On Error GoTo 0

Kill RutaCompleta

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

Exit Sub

Err:

MsgBox Err.Description, vbCritical + vbOKOnly, Err.Number

End Sub[/ltr]



Gracias por su pronto apoyo

fernandezdennis


'Creo que podrias probar en donde definis destinatario y remitente, 'agregar con copia a y copia oculta con estas 2 líneas
'hay que probar si funciona con separación por puntos y comas
'Espero te sirva.

With Email
.To = Destinatario
.From = Remitente


.CC="aa@dominio.com;bb@dominio.com"
.BCC="[email=aa@dominio.com;bb@dominio.com]aa@dominio.com;bb@dominio.com[/email]"

 .Subject = Asunto
.TextBody = Cuerpo
.AddAttachment RutaCompleta
.Configuration.Fields.Update
On Error Resume Next
.Send
End With

Ver el tema anterior Ver el tema siguiente Volver arriba  Mensaje [Página 1 de 1.]

Permisos de este foro:
No puedes responder a temas en este foro.