obriensj
04-28-2010, 02:27 AM
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
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
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
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