I have a folder with 50 files and I have a list of 50 email addresses. Each file goes to a different email address. Is there a way to write a macro that performs this task?
The problem with the set of code below is two-fold:
1) I have 3 COLUMNS of data in an Excel file: One for subject, one for email address to send to, and the third for the FILE PATH of where the attachment to be attached is stored.
The code below does not allow for a pre-determined set of subject arguments. It also uses ROWS?? for the filepath field instead of a column like it does for send to? So confusing.
Sub Send_Files() Dim OutApp As Object Dim OutMail As Object Dim sh As Worksheet Dim cell As Range Dim FileCell As Range Dim rng As Range With Application .EnableEvents = False .ScreenUpdating = False End With Set sh = Sheets("Sheet1") Set OutApp = CreateObject("Outlook.Application") For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants) 'Enter the path/file names in the C:Z column in each row Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1") If cell.Value Like "?*@?*.?*" And _ Application.WorksheetFunction.CountA(rng) > 0 Then Set OutMail = OutApp.CreateItem(0) With OutMail .to = cell.Value .Subject = "Testfile" .Body = "Hi " & cell.Offset(0, -1).Value For Each FileCell In rng.SpecialCells(xlCellTypeConstants) If Trim(FileCell) <> "" Then If Dir(FileCell.Value) <> "" Then .Attachments.Add FileCell.Value End If End If Next FileCell .Send 'Or use .Display End With Set OutMail = Nothing End If Next cell Set OutApp = Nothing With Application .EnableEvents = True .ScreenUpdating = True End With End Sub
Here is quick example, assuming
col A = Email, Col B = Subject & Col C = Path
Option Explicit Public Sub Example() Dim olApp As Object Dim olMail As Object Dim olRecip As Object Dim olAtmt As Object Dim iRow As Long Dim Recip As String Dim Subject As String Dim Atmt As String iRow = 2 Set olApp = CreateObject("Outlook.Application") Dim Sht As Worksheet Set Sht = ThisWorkbook.Worksheets("Sheet1") Do Until IsEmpty(Sht.Cells(iRow, 1)) Recip = Sht.Cells(iRow, 1).Value Subject = Sht.Cells(iRow, 2).Value Atmt = Sht.Cells(iRow, 3).Value ' Attachment Path Set olMail = olApp.CreateItem(0) With olMail Set olRecip = .Recipients.Add(Recip) .Subject = Subject .Body = "Hi " .Display Set olAtmt = .Attachments.Add(Atmt) olRecip.Resolve End With iRow = iRow + 1 Loop Set olApp = Nothing End Sub