I have a code that sends a personalized email to clients on a list and attaches a customized excel spreadsheet to the email for each client. My Coworker wanted a line that would show all emails without attachments. The rest of the code works and sends everything correctly but the moment I inserted the Blue Section Below it crashed hard. I was wondering if anyone could help me with the display if no attachment part of the code.
Sub Button1_Click() 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("Sheet 1") 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 .CC = "Coworker Email Here" .Subject = cell.Offset(0, 2).Value & "-Company Verbiage here...-" & cell.Offset(0, -1).Value .Body = "Company Verbiage here..." 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 If .Attachments.Count > 0 Then .send Else .Display 1 End If End With Set OutMail = Nothing End If Next cell Set OutApp = Nothing With Application .EnableEvents = True .ScreenUpdating = True End With End Sub