H
Hervinder
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 = "(e-mail address removed)"
.CC = ""
.BCC = ""
.From = """Ron"" <[email protected]>"
.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
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 = "(e-mail address removed)"
.CC = ""
.BCC = ""
.From = """Ron"" <[email protected]>"
.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