I resolved this on my own -

Sub ContactList()

Dim olApp As Object Dim olMailItm As Object Dim iCounter As Integer Dim Dest As Variant Dim SDest As String Dim CC As String Dim myValue As Variant Dim myCC As Variant Dim myAttachment As Variant Dim SigString As String Dim Signature As String Dim Path As Variant Dim Check As Variant

myValue = InputBox("Set Subject Line - Press cancel to end macro" & vbCr & vbCr & "Did you add a Text Box (Insert>Text Box) with the body of your email in it?" & vbCr & vbCr & "You can now use HTML5 to encode your text!" & vbCr & vbCr & "For example, type <p style='font-family:'Calibri' font size='11pt'> in front of your text if you use standard Mercer email settings, and </font> at the end for a better looking message. Use full quotations instead of apostrophes. Type <BR><BR> to add a line break. Email will be displayed prior to sending to correct any formatting errors." & vbCr & vbCr, "Subject and Description", "Subject must be included") If myValue = "" Then Exit Sub

myCC = InputBox("Set CC Line", "CC") If myCC = vbCancel Then Exit Sub Path = InputBox("Add the path to any attachments you wish to add. Select Cancel to send without attachments", "Attachments") Check = MsgBox("Send Email?", vbYesNo, "Final Check") If Check = vbNo Then Exit Sub

Set olApp = CreateObject("Outlook.Application") Set olMailItm = olApp.CreateItem(0) SigString = Environ("appdata") & _ "\Microsoft\Signatures\Cory.htm" '<Replace cory with the name of your signature'

If Dir(SigString) <> "" Then Signature = GetBoiler(SigString) Else Signature = "" End If On Error Resume Next

With olMailItm SDest = "" For iCounter = 1 To WorksheetFunction.CountA(Columns(1)) If SDest = "" Then SDest = Cells(iCounter, 1).Value Else SDest = SDest & ";" & Cells(iCounter, 1).Value End If Next iCounter

.BCC = SDest .CC = myCC .Subject = myValue .HTMLBody = ActiveSheet.TextBoxes(1).Text & "<br><br>" & Signature .display .attachments.Add Path .HTMLBody = ActiveSheet.TextBoxes(1).Text & "<br><br>" & Signature .send End With

Set olMailItm = Nothing Set olApp = Nothing Result = MsgBox("Emails Sent", vbOKOnly, "Complete")

End Sub

Function GetBoiler(ByVal sFile As String) As String

Dim fso As Object Dim ts As Object Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.getfile(sFile).OpenAsTextStream(1, -2) GetBoiler = ts.readall ts.Close End Function