I'm sure many of you have seen the macro's on ron de bruins site regarding
emails.

I found one which almost does the job for me but it needs a slight
adjustment which i need help with.

The macro is the one that sends and email with a workbook as an attachment.
I want to modify it if possible to attach more than one file. i will list
the files with email addresses on a spreadsheet and all files are saved in
one location. So basically one email can have x number of files attached and
sent to a specified address.

i'm pasting the macro from his site below;

Option Explicit

'This procedure will mail the whole workbook
'You can 't send a Workbook that is open with CDO.
'That's why it use SaveCopyAs to save it with another name and send that file.


Sub CDO_Mail_Workbook()
'Working in 2000-2007
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim iMsg As Object
Dim iConf As Object
' Dim Flds As Variant

Set wb = ActiveWorkbook

If Val(Application.Version) = 12 Then
If wb.FileFormat = 51 And wb.HasVBProject = True Then
MsgBox "There is VBA code in this xlsx file, there will be no
VBA code in the file you send." & vbNewLine & _
"Save the file first as xlsm and then try the macro
again.", vbInformation
Exit Sub
End If
End If

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

'Make a copy of the file/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = "Copy of " & wb.Name & " " & Format(Now, "dd-mmm-yy
h-mm-ss")
FileExtStr = "." & LCase(Right(wb.Name, Len(wb.Name) - InStrRev(wb.Name,
".", , 1)))

wb.SaveCopyAs TempFilePath & TempFileName & FileExtStr

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

' iConf.Load -1 ' CDO Source Defaults
' Set Flds = iConf.Fields
' With Flds
'
..Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Fill in
your SMTP server here"
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
' .Update
' End With

With iMsg
Set .Configuration = iConf
.To = "
.CC = ""
.BCC = ""
.From = """Ron"" "
.Subject = "This is a test"
.TextBody = "This is the body text"
.AddAttachment TempFilePath & TempFileName & FileExtStr
.Send
End With

'If you not want to delete the file you send delete this line
Kill TempFilePath & TempFileName & FileExtStr

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Hi Hervinder

Repeat the AddAttachment line

..AddAttachment TempFilePath & TempFileName & FileExtStr
..AddAttachment "C:\test1.xls"
..AddAttachment "C:\test2.xls"


--

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


"Hervinder" wrote in message ...
I'm sure many of you have seen the macro's on ron de bruins site regarding
emails.

I found one which almost does the job for me but it needs a slight
adjustment which i need help with.

The macro is the one that sends and email with a workbook as an attachment.
I want to modify it if possible to attach more than one file. i will list
the files with email addresses on a spreadsheet and all files are saved in
one location. So basically one email can have x number of files attached and
sent to a specified address.

i'm pasting the macro from his site below;

Option Explicit

'This procedure will mail the whole workbook
'You can 't send a Workbook that is open with CDO.
'That's why it use SaveCopyAs to save it with another name and send that file.


Sub CDO_Mail_Workbook()
'Working in 2000-2007
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim iMsg As Object
Dim iConf As Object
' Dim Flds As Variant

Set wb = ActiveWorkbook

If Val(Application.Version) = 12 Then
If wb.FileFormat = 51 And wb.HasVBProject = True Then
MsgBox "There is VBA code in this xlsx file, there will be no
VBA code in the file you send." & vbNewLine & _
"Save the file first as xlsm and then try the macro
again.", vbInformation
Exit Sub
End If
End If

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

'Make a copy of the file/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = "Copy of " & wb.Name & " " & Format(Now, "dd-mmm-yy
h-mm-ss")
FileExtStr = "." & LCase(Right(wb.Name, Len(wb.Name) - InStrRev(wb.Name,
".", , 1)))

wb.SaveCopyAs TempFilePath & TempFileName & FileExtStr

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

' iConf.Load -1 ' CDO Source Defaults
' Set Flds = iConf.Fields
' With Flds
'
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Fill in
your SMTP server here"
'
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
' .Update
' End With

With iMsg
Set .Configuration = iConf
.To = "
.CC = ""
.BCC = ""
.From = """Ron"" "
.Subject = "This is a test"
.TextBody = "This is the body text"
.AddAttachment TempFilePath & TempFileName & FileExtStr
.Send
End With

'If you not want to delete the file you send delete this line
Kill TempFilePath & TempFileName & FileExtStr

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub