Hi, I wonder whether someone may be able to help me please.
Using a tutorial I've found here: http://www.rondebruin.nl/win/s1/outlook/amail6.htm I'm trying to put togther a script which runs through a list of potential email recipients and where the signal is set to "yes", attach two files and send an emal to the chosen recipient.
The format of the sheet is as follows:
Column B - Recipient Name
Column C- Recipients Email Address
Column B - Recipient Name
Column D - Send Email Signal
Columns E-F - Links to files to attach
The code below is the script which I've put together so far:
***UPDATED CODE***
Sub Send_Files()
'Working in Excel 2000-2013
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim LastRow As Long
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")
Const StartRow As Long = 4
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("C").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the C:Z column in each row
LastRow = Cells(Rows.Count, "C").End(xlUp).Row
If LastRow >= StartRow Then
Set rng = Range("E4:F" & Range("C" & Rows.Count).End(xlUp).Row)
End If
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "D").Value) = "yes" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = cell.Value
.Subject = "Testfile"
.Body = "Hi "
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
I've tried to adapt the code at this point so that the range starts from row 4 until the last row:
For Each cell In sh.Columns("C").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the C:Z column in each row
LastRow = Cells(Rows.Count, "C").End(xlUp).Row
If LastRow >= StartRow Then
Set rng = Range("E4:F" & Range("C" & Rows.Count).End(xlUp).Row)
End If
I can recieve the email without a problerm, but the attachments are not attached to the email.
I just wondered whether someone could possibly look at this please and let me know where I'm going wrong.
Many thanks and kind regards
Bookmarks