Hello,
I am trying to create a macro where Excel creates an email and attaches a document to be sent to insurance companies selected from a list. The user will select yes next to the name of the insurer that they want the document sent to.
This is what I have created so far but the issue I have is that if the user selects four different insurers, instead of creating four emails with the correct doc attached, it creates one email and attaches the document four times and inserts the body text four times. What am I doing wrong?
Sub Underwriter()
Dim objOutlook As Object
Dim objMail As Object
Dim projectRow As Long
Dim ProjectName As String
Dim insurerCell As Excel.Range
Dim acceptedInsurers As String
Dim Signature As String
Dim fd As FileDialog
Dim NDAPath As String
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
' Move to Cell A
Cells(ActiveCell.Row, 1).Select
' Check row is valid
If ActiveCell.Address = "$A$1" Or ActiveCell.Address = "$A$2" _
Or ActiveCell.Address = "$A$3" Or ActiveCell.Address = "$A$4" _
Or ActiveCell = "" Then
MsgBox "Please select a project!"
Exit Sub
End If
projectRow = ActiveCell.Row
ProjectName = ActiveCell
' Create file path to NDA
Set fd = Application.FileDialog(msoFileDialogFilePicker)
If fd.Show = -1 Then
NDAPath = fd.SelectedItems(1)
End If
' Select insurers
For Each insurerCell In Range(Cells(4, 2), Cells(4, Cells(4, Columns.Count).End(xlToLeft).Column)).Cells
If Intersect(Rows(projectRow).EntireRow, insurerCell.EntireColumn).Value = "Yes" Then
' Create e-mail
With objMail
.Display
.Subject = "Market Strategy - Project " & ProjectName
.Attachments.Add NDAPath
.HTMLBody = "test" _
& .HTMLBody
End With
End If
Next insurerCell
Set objOutlook = Nothing
Set objMail = Nothing
End Sub
Bookmarks