Email Worksheet using VBA (small modification to code) : SUBJECT Change (...help please)

[dwilson38550m]

Hi,

I have been struggling with this - I have a macro which works well but I want the ability to change the SUBJECT line for each email I send. Can I point this to a cell (column A) so that a unique name is noted on the subject header of each email. In essence the macro runs through a list of names, attaches a file and sends, then moves to the next row and repeats, then the next row etc etc.

SHEET1
Column A Blank - I want the SUBJECT in here (example, Cell A1 SUBJECTABD, Cell A2, SUBJECTXYZ, Cell A3 SUBJECT DEF)
Column B - the "to" email addresses
Column C, D, E, F etc - the file attachment.

I have noted below the (think I just need a small adjustment). Thanks in advance.

The code I use is :
-----------------------------------------------------------------------------------


Sub emailgood()
'
' emailgood Macro
'

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)

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 = "Email Header"
.Body = "Dear Sir/Madam, " & vbLf & vbLf & "Please find attached xxxx" & vbLf & vbLf & "Kind regards," & vbLf & vbLf & "David" & vbLf & vbLf & "Credit Controller" & 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
End With

Set OutMail = Nothing
End If
Next cell

Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

 

[James_Latimer]

If i have understood you correctly (you want the string in column A to be the subject of the email) then maybe something like this?

.Subject = cell.Offset(0, -1).Value

 

[dwilson38550m]

Perfect. That works. Thanks

 

[James_Latimer]

Marvellous. You’re more than welcome.