Seleccionar destinatarios para enviar por mail
Tengo el siguiente código que me genera una pdf de la hoja actual y me la envía por mail sin usar el Outlook y lo que quiero añadir a este código es la posibilidad de escoger varios destinatarios que tengo en la hoja5 "Destinatarios" la cual tiene tres columnas: 1 código 2 correo 3 Validación(si, no).
-Quiero que envié a los que valido con el sí.
A ver si es posible y gracias como siempre por vuestra atención y colaboración
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
1 Respuesta
Respuesta de Aneudys Martinez
1