Macro para enviar correo a destinatario con copias por gmail desde excel
Encontré esta macro y funciona bien, pero quisiera que me ayudaran para que pudiera enviar con copias y copias ocultas. Anexo macro:
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 = "[email protected]" Pass = "Password" Destinatario = "[email protected]" 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
2 Respuestas
Respuesta de Dante Amor
1
Respuesta de Programar Excel
1