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
1

Con esto lo puede logra

Por lo que pude entender este correo va destinado para todas la tenga la condición SI

Despues del cometario donde duce informacion para el correo copia este codigo

hoja5.Range("H1") = ""
For Each celda In hoja5.Range("C2:C10")
If celda = "SI" Then
hoja5.Range("H1") = hoja5.Range("H1") & " " & celda.Offset(0, -1) 
End If  
Next 
Destinataio = hoja5.Range("H1") 

donde   hoja5.Range("C2:C10")  cambia el rango 

donde va el destinatatio seria asi

Destinataio = hoja5.Range("H1")

al final de la macro 

hoja5.Range("H1") = " "

No olvides valorar 

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas