Email macro stops after sending first email

[obriensj]

Hi,

I have the below code I have put together and seems to work to certain extent and then stops!
Basically the code looks for csv files stored on the server, open the files up, looks for the email address is cell M1 and emails the csv file to that email address.
I ran and it works fine for the first file, in that it opens the csv file, creates the email and sends automatically.
However I have multiple csv files stored in the folder and it just seems to open the other csv files and closes them down without emailing them, why is this happening?

Also I put in an IF Not statement for range M1 as sometimes there might not be an email address in cell M1 so I wanted the macro to ignore this and move onto the next csv file, however it still opens the file and looks like it is going to email it but it does not, any ideas why this is happening?

Any help appreciated as this is driving me nuts!

Thanks



[VBA]Sub process_228_Email()
'
' ProcessData Macro
' Macro recorded 24/03/2010 by obriensj

Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)



Application.DisplayAlerts = False

With Application.FileSearch
.LookIn = "J:\STOCK RECS\Email228testing\Process"
.Filename = "*IVP228*.csv"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i)


If Not Range("M1").Value = "" Then
'Range("M1").TextToColumns Destination:=Range("M1"), DataType:=xlFixedWidth,
'OtherChar:="|", FieldInfo:=Array(Array(0, 2), Array(5, 1), Array(8, 1), Array(19, 1), _
'Array(28, 1), Array(42, 1), Array(75, 1), Array(104, 1), Array(124, 1)), _
'TrailingMinusNumbers:=True
End If

Columns("A:A").ColumnWidth = 60.09
Columns("B:B").ColumnWidth = 25.14
Columns("C:C").ColumnWidth = 15.29
Range("A1").Select
With Selection
.HorizontalAlignment = xlLeft

End With


asatdate = Range("M1")
asatdate1 = Range("A1")
asatdate2 = Range("B1")


On Error Resume Next
With OutMail
.To = asatdate
'Set the "From" field
'.From = """Stoc Recs"" <steve@test.com>"
.CC = "John@test.com"
'.BCC = ""
.Subject = "TEST Disclosure Request" & " " & asatdate1 & " " & asatdate2
.body = _
"Hi, " & vbCr & vbCr & _
"Please find enclosed disclosure request." & vbCr & vbCr & _
"Kind regards, " & vbCr & vbCr & _
"Stock dept" & vbCr & vbCr & _
"Bank plc" & vbCr & vbCr & _
"Email: steve@test.com" & vbCr & vbCr
.Attachments.Add ActiveWorkbook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
'.send 'or use .Display
.send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

ActiveWorkbook.Close



Next i
Else
MsgBox "There were no files found."
End If
End With

On Error Resume Next
Kill "J:\STOCK RECS\Email228testing\Process\*.*" ' delete all files in the folder
'RmDir "C:\Users\Ron\Test\" ' delete folder
On Error GoTo 0

ActiveWorkbook.Close

End Sub[/VBA]

[Aussiebear]

When posting code to the forum, please wrap your code with the correct tags by using the vba Button. I've done it for you on this occassion.