Hi

I have the following code to send files direct from excel
but when I run this it comes up with the error 'Out of
Memory' does any have any ideas why this is happening?

Code:

Sub AutoSend()
Dim olApp As Outlook.Application
Dim olMail As MailItem
Dim cell As Range
Application.ScreenUpdating = False
Set olApp = New Outlook.Application
For Each cell In Sheets("Sheet1").Columns
("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Offset(0, 1).Value < "" Then
If cell.Value Like "*@*" And Dir(cell.Offset
(0, 1).Value) < "" Then
Set olMail = olApp.CreateItem(olMailItem)
With olMail
.To = cell.Value
.Subject = "Remittance Advice"
.Body = "Please see the attached
Remittance advice and Cover Note"
.Attachments.Add cell.Offset(0,
1).Value
.Attachments.Add ("c:\remit\Remittance
Cover Note.doc")
.Display 'Or use Display
End With
Set olMail = Nothing
End If
End If
Next cell
Set olApp = Nothing
Application.ScreenUpdating = True
End Sub

Hi Edgar

Because there is a bug in Outlook it is possible that you must uncheck
"send immediately when connect" in the Outlook options.
<ToolsOptionsMail Setup in the Outlook menu

Problem :
It will not close the Outlook process after the mail is sent in the Task Manager



--
Regards Ron de Bruin
(Win XP Pro SP-1 XL2000-2003)
www.rondebruin.nl



"Edgar Thoemmes" wrote in message ...
Hi

I have the following code to send files direct from excel
but when I run this it comes up with the error 'Out of
Memory' does any have any ideas why this is happening?

Code:

Sub AutoSend()
Dim olApp As Outlook.Application
Dim olMail As MailItem
Dim cell As Range
Application.ScreenUpdating = False
Set olApp = New Outlook.Application
For Each cell In Sheets("Sheet1").Columns
("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Offset(0, 1).Value < "" Then
If cell.Value Like "*@*" And Dir(cell.Offset
(0, 1).Value) < "" Then
Set olMail = olApp.CreateItem(olMailItem)
With olMail
.To = cell.Value
.Subject = "Remittance Advice"
.Body = "Please see the attached
Remittance advice and Cover Note"
.Attachments.Add cell.Offset(0,
1).Value
.Attachments.Add ("c:\remit\Remittance
Cover Note.doc")
.Display 'Or use Display
End With
Set olMail = Nothing
End If
End If
Next cell
Set olApp = Nothing
Application.ScreenUpdating = True
End Sub