Group Email and File Distribution

[becullen619]

I am trying to write a macro which will copy a range of cells into an Outlook email and add an attachment which will be sent to a group of people on a distribution list, also included in the workbook.

The code I am using is:

Sub Cash_Email()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim strto As String

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

On Error GoTo cleanup
For Each cell In ThisWorkbook.Sheets("Distrib").Range("A1:A10")
If cell.Value Like "?*@?*.?*" Then
strto = strto & cell.Value & ";"
End If
If Len(strto) > 0 Then strto = Left(strto, Len(strto) - 1)
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.Subject = "Daily Liquidity"
.Body = Cells(cell.Row, "A1:B12").Value _
& vbNewLine & vbNewLine & _
"Cash File Attached"
'You can add files also like this
.Attachments.Add ("S:\2010\TREASURY\03 - March 2010\2010 March Daily Dashboard.xls")
.Send 'Or use Display
End With
On Error GoTo 0
Set OutMail = Nothing
Next cell


cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

However, the code seems to get hung up on the line:
" Set OutMail = OutApp.CreateItem(0)"
and looping in my Outlook, asking me over and over if I want to send an email, but never sending one.

Anyone have any ideas?

 

[John_w]

Are you clicking Yes/Allow to the Outlook prompt?

See http://www.rondebruin.nl/mail/prevent.htm to prevent the warning and other email tips.