Macro para enviar correos masivos con adjuntos diferentes

Me puedes apoyar con la macro y el archivo para

Macro para enviar correos masivos con adjuntos diferentes

1 respuesta

Respuesta
1

H o l a:

Te anexo las macros que van en los eventos de la hoja

Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dam
On Error Resume Next
If Not Intersect(Target, Range("B:B")) Is Nothing Then
    For Each t In Target
        If t.Value <> "" Then
            Cells(t.Row, "G").Select
            ActiveSheet.Hyperlinks.Add _
                Anchor:=Selection, _
                Address:="", _
                SubAddress:="Hoja1!C" & t.Row, _
                TextToDisplay:="Insertar archivo"
        End If
    Next
    Cells(Target.Row, 3).Select
End If
End Sub
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
'Por.Dam
    linea = ActiveCell.Row
    'col = Range("H1").Column
    col = Cells(linea, Columns.Count).End(xlToLeft).Column + 1
    If col < 8 Then col = 8
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Seleccione uno o varios archivos"
        .Filters.Clear
        .Filters.Add "archivos pdf", "*.pdf*"
        .Filters.Add "archivos de excel", "*.xls*"
        .Filters.Add "Todos los archivos", "*.*"
        .FilterIndex = 2
        .AllowMultiSelect = True
        .InitialFileName = ThisWorkbook.Path
        If .Show Then
            For Each ar In .SelectedItems
                'rutaarchivo = .SelectedItems.Item(i)
                Cells(linea, col) = ar
                col = col + 1
            Next
        End If
    End With
End Sub

Sigue las Instrucciones para poner la macro en los eventos de worksheet

  1. Abre tu libro de excel
  2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
  3. Del lado izquierdo dice: VBAProject, abajo dale doble click a worksheet(tu hoja)
  4. Del lado derecho copia la macro

La siguiente macro va en un módulo

'***Macro Para enviar correos
Sub correo()
'Por.Dante Amor
    col = Range("H1").Column
    For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
        Set dam = CreateObject("outlook.application").createitem(0)
        dam.To = Range("B" & i) 'Destinatarios
        dam.CC = Range("C" & i) 'Con copia
        dam.Bcc = Range("D" & i) 'Con copia oculta
        dam.Subject = Range("E" & i) '"Asunto"
        dam.body = Range("F" & i) '"Cuerpo del mensaje"
        '
        For j = col To Cells(i, Columns.Count).End(xlToLeft).Column
            archivo = Cells(i, j)
            If archivo <> "" Then dam.Attachments.Add archivo
        Next
        dam.send 'El correo se envía en automático
        'dam.display 'El correo se muestra
    Next
    MsgBox "Correos enviados", vbInformation, "SALUDOS"
End Sub

Sigue las Instrucciones para poner la macro en un módulo

  1. Abre tu archivo de excel
  2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
  3. En el menú elige Insertar / Módulo
  4. En el panel del lado derecho copia la macro

La estructura de la hoja es la siguiente:


Añade tu respuesta

Haz clic para o

Más respuestas relacionadas