I have received the attached code which will send an email with an
attachment, using a list that contains recepient name, email address,
and attachment path. My job is using email addresses that are
contained in my global address book, and would prefer to use the name
instead of the email address. What code needs to be changed to make
this work.

Sub Send_Files()
'Working in 2000-2007
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim sh As Worksheet
Dim cell As Range, FileCell As Range, rng As Range
Dim strSubject, strBody, strNote, StrMessage

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set sh = Sheets("Sheet1")

Set OutApp = CreateObject("Outlook.Application")
'OutApp.Session.Logon

strSubject = InputBox("Please enter the subject of today's mail:",
"Message Subject Entry", "")
strNote = ""
StrMessage = InputBox("Please enter message here:", "Message
Entry", "")
strBody = strNote & Chr(10) & _

For Each cell In
sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)

'Enter the file names in the C:Z column in each row
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(olMailItem)

With OutMail
.SentOnBehalfOfName = ""
.To = "cell.Value"
.Subject = strSubject
.Body = strBody
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

Hi Graig

Try this instead of .To

..Recipients.Add "TheName"

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"craig" <(E-Mail Removed)> wrote in message news:1a764aa4-6f08-4635-a607-(E-Mail Removed)...
>I have received the attached code which will send an email with an
> attachment, using a list that contains recepient name, email address,
> and attachment path. My job is using email addresses that are
> contained in my global address book, and would prefer to use the name
> instead of the email address. What code needs to be changed to make
> this work.
>
> Sub Send_Files()
> 'Working in 2000-2007
> Dim OutApp As Outlook.Application
> Dim OutMail As Outlook.MailItem
> Dim sh As Worksheet
> Dim cell As Range, FileCell As Range, rng As Range
> Dim strSubject, strBody, strNote, StrMessage
>
> With Application
> .EnableEvents = False
> .ScreenUpdating = False
> End With
>
> Set sh = Sheets("Sheet1")
>
> Set OutApp = CreateObject("Outlook.Application")
> 'OutApp.Session.Logon
>
> strSubject = InputBox("Please enter the subject of today's mail:",
> "Message Subject Entry", "")
> strNote = ""
> StrMessage = InputBox("Please enter message here:", "Message
> Entry", "")
> strBody = strNote & Chr(10) & _
>
> For Each cell In
> sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
>
> 'Enter the file names in the C:Z column in each row
> 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(olMailItem)
>
> With OutMail
> .SentOnBehalfOfName = ""
> .To = "cell.Value"
> .Subject = strSubject
> .Body = strBody
> 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