Mail Merge Using Excel, adding attachments - need help...

[Xeroid]

I pulled this code from the web (thank you to its creator - Ron De Bruin,
http://www.rondebruin.nl/mail/folder2/mail1.htm).

(By the way, the names in column "D" are lastname, firstname format, as MS Outlook's address book is set up to look up the name on the company list and convert it to the proper e-mail format automatically).

It has worked well until yesterday, when mysteriously, it now no longer attaches the files listed in columns F:K into the note that it generates.

...And I can't understand why...

Here's the code:

Sub Email_DER_Files()
'
'

' Code based on that from website of Ron De Bruin,
' http://www.rondebruin.nl/mail/folder2/mail1.htm

Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range, FileCell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
PeopleList = Range("D2:D65535").End(xlDown).Row

'(More notes needed... out of time...)

'With Range("e2:e" & PeopleList)
' .Formula = "=RIGHT(D2,LEN(D2)-FIND("","",D2)-1)"
' .Value = .Value
'End With

'With Range("f2:f" & PeopleList)
' .Formula = "=""C:\E051497\Records Retention\Destructions\2008 DERs\""&A2&""_""&B2&""-Destruction Eligibility Report 2008.xls"""
' .Value = .Value
'End With

'INSERT STOP HERE TO POPULATE AND THEN VERIFY FORMULAE BEFORE RUNNING E-MAIL SECTION OF THIS MACRO

'Check e-mail name list in column "D", see if it is in "Lastname, Firstname" format
'and see if there is file path information in range F:I on the same line.
'If true, create mail note with pre-set form letters for subject and body.

For Each cell In Sheets("Coord. Lists (2)").Range("D2:D" & PeopleList).Cells. _
SpecialCells(xlCellTypeConstants)

If cell.Value Like "?*, ?*" And Application.WorksheetFunction.CountA( _
Sheets("Coord. Lists (2)").Cells(cell.Row, 1).Range("f1:k1")) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = cell.Value
.Subject = "2008 Destruction Eligibility Report for " & _
cell.Offset(0, -1).Text & ", Dept " & cell.Offset(0, -2).Text & "."
.Body = "Hi " & cell.Offset(0, 1).Value & "." & Chr(13) & Chr(13) & _
"The attached files are lists of boxes of obsolete records due to be destroyed by January 1st, 2009 or sooner. " & _
Chr(13) & Chr(13) & "If you have received more than one of these notices, it is because" _
& " your name is listed as the Records Coordinator for more than one department. Each list " _
& " will refer to a different department that needs to be verified (see attachment)." _
& Chr(13) & Chr(13) & "If any corrections need to be made, please make the changes on the attached form," & _
" save the changes and forward them to Bill.Robbins@Xerox.com" & _
Chr(13) & Chr(13) & "Regards," & Chr(13) & Chr(13) & Chr(13) & "Regards," _
& Chr(13) & "Records Administration."

'Enter the file names in the F:K column in each row
'You can make the range bigger if you want, only change the column not the 1
'Bear in mind that the sheet name may have to be updated if you have named
'your sheet.
For Each FileCell In Sheets("Coord. Lists (2)").Cells(cell.Row, 1).Range("f1:k1") _
.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell

.Display 'Or use .Send
End With
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub


...Any help would be very much appreciated.

 

[Xeroid]

Figured it out. I had changed the last part of the file names in the directory that the attachments were being pulled from to something else, so it was as if the files that the macro was calling did not exist. I fixed the file names in the F:K range with a find and replace and it is working beautifully again. Sorry to bug you guys for something simple that I was able to fix on my own!