Send email macro to multiple recipients

[laurainwa]

I'm using the macro listed below (from RondeBruin) to send a worksheet as an attachment. It works great, except I am sending it to multiple recipients and I have to click the "allow" program to send email for each and every email. Is there a way to just send one email to everyone I need? I need to know what part of this code to delete and what to replace it with. (I don't know really anything about VBA code so I need it in as simple terms as possible. )
Sub Mail_ActiveSheet()
'Working in 97-2010
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim I As Long

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

Set Sourcewb = ActiveWorkbook

'Copy the sheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2010, we exit the sub when your answer is
'NO in the security dialog that you only see when you copy
'an sheet from a xlsm file with macro's disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With

' 'Change all cells in the worksheet to values if you want
' With Destwb.Sheets(1).UsedRange
' .Cells.Copy
' .Cells.PasteSpecial xlPasteValues
' .Cells(1).Select
' End With
' Application.CutCopyMode = False

'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & " " _
& Format(Now, "dd-mmm-yy h-mm-ss")

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
For I = 1 To 3
.SendMail "ron@debruin.nl", _
"This is the Subject line"
If Err.Number = 0 Then Exit For
Next I
On Error GoTo 0
.Close SaveChanges:=False
End With

'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr

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

 

[Siyanna]

Sorry also forgot to mention that the E-Mails are set to display not send
to change it, change these lines

.display ' delete this line
'.Send 'Remove the apostrophe from the start of this line

Hi Michael,

Firstly I would like to say i have not tested the code yet but I am sure it will work Fine. Thank You so much for your help. Is there any chance you can explain how the code works

TempFilePath = Environ$("temp") & "\"
    TempFileName = ws.Range("A" & i).Value & " " & Format(Now, "dd-mmm-yy")
    FileExtStr = ".xls"
    FileFormatNum = 56

With ActiveWorkbook
            .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        End With
        Set Mail_Object = CreateObject("Outlook.Application")
        With Mail_Object.CreateItem(o)

How does this part work and what is the o (CreateItem(o)

Kill TempFilePath & TempFileName & FileExtStr
    Set OutMail = Nothing
    Set OutApp = Nothing

I understand the rest of the code..Thank you so much....


One last major thing that might be a problem is that on the sheets that i am copying over, i have some macro buttons on there so that users can navigate around on that paticular sheet (Application.go etc)

Is there anyway i can copy the macros over so that users can navigate around as normal. If i just copy it over, it will not copy the macros over which is going to be a problem for me.

The macros is in a module.

Thank You So much sir and much appreciated.

x

 

[Siyanna]

Hi Michael,

Firstly I would like to say i have not tested the code yet but I am sure it will work Fine. Thank You so much for your help. Is there any chance you can explain how the code works

TempFilePath = Environ$("temp") & "\"
    TempFileName = ws.Range("A" & i).Value & " " & Format(Now, "dd-mmm-yy")
    FileExtStr = ".xls"
    FileFormatNum = 56

With ActiveWorkbook
            .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        End With
        Set Mail_Object = CreateObject("Outlook.Application")
        With Mail_Object.CreateItem(o)

How does this part work and what is the o (CreateItem(o)

Kill TempFilePath & TempFileName & FileExtStr
    Set OutMail = Nothing
    Set OutApp = Nothing

I understand the rest of the code..Thank you so much....


One last major thing that might be a problem is that on the sheets that i am copying over, i have some macro buttons on there so that users can navigate around on that paticular sheet (Application.go etc)

Is there anyway i can copy the macros over so that users can navigate around as normal. If i just copy it over, it will not copy the macros over which is going to be a problem for me.

The macros is in a module.

Thank You So much sir and much appreciated.

x

Forgot to mention the macros are in MODULE 2

I have also just tested the code and have this message when creating the outlook application (
RUN TIME ERROR 429
ACTIVE X COMPONENT CANT CREATE OBJECT

Do i have to have outlook open first?

 

[Siyanna]

Thank you Michael M

 

[Michael M]

This block saves the file to a temporary location with temporary name
TempFilePath = Environ$("temp") & "\"
    TempFileName = ws.Range("A" & i).Value & " " & Format(Now, "dd-mmm-yy")
    FileExtStr = ".xls" makes sure the file is an xls extension
    FileFormatNum = 56 ensures this is in version 2003
 saves the file based on the above block
With ActiveWorkbook
            .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        End With
        Set Mail_Object = CreateObject("Outlook.Application")
        With Mail_Object.CreateItem(o) creates the mail item (o)bject
How does this part work and what is the o (CreateItem(o)

 deletes the temp file and resets the mail objects to empty
Kill TempFilePath & TempFileName & FileExtStr
    Set OutMail = Nothing
    Set OutApp = Nothing

What version of EXcel are you using, and which line gives the error !

 

[Michael M]

No, Outlook does not need to be open

 

[Michael M]

Which version of Outlook are you using !!

 

[Siyanna]

Hi Michael,

Thank you for your explanination

I am using excel 2007 and my main file is saved as an xlsm file.

I am currently testing this on my home computer which does not have outlook however i will be using this at work which has outlook (Im not sure which version).

Still not sure about this part creates the mail item (o)bject

One last major thing that might be a problem is that on the sheets that i am copying over, i have some macro buttons on there so that users can navigate around on that paticular sheet (Application.go etc)

Is there anyway i can copy the macros over so that users can navigate around as normal. If i just copy it over, it will not copy the macros over which is going to be a problem for me.

I basically need to copy MODULE 2 from VBA also

Thank You Sir x

Am i right in saying

Mail_Object.CreateItem(o) 'this part is like saying File (newmail)
Set OutMail = Nothing ' this part sets everything in the mail i am sending to blank
Set OutApp = Nothing ' not sure about this one

 

[Michael M]

Ok, for 2007 you will need to change a couple of lines

This

 FileExtStr = ".xls"
needs to be 
 FileExtStr = ".xlsm"

AND this
FileFormatNum = 56
needs to be
FileFormatNum = 52

The code will not work without Outlook, not even Outlook Express !!
Macros cannot be sent with the sheet, if they are in a Module.
If sending individual sheets, the code must reside in the worksheet itself.

creates the mail item (o)bject
the mail item object is the actual mail message

 

[Siyanna]

Ok, for 2007 you will need to change a couple of lines

This

 FileExtStr = ".xls"
needs to be 
 FileExtStr = ".xlsm"
 
AND this
FileFormatNum = 56
needs to be
FileFormatNum = 52

The code will not work without Outlook, not even Outlook Express !!
Macros cannot be sent with the sheet, if they are in a Module.
If sending individual sheets, the code must reside in the worksheet itself.

creates the mail item (o)bject
the mail item object is the actual mail message

Thank You so much michael...

In regards to the copying of macro...

Are you saying that the macro i have in module 2

i.e

Sub YELLOW()
Application.Goto Range("A42"), SCROLL:=True
End Sub
Sub PINK()
Application.Goto Range("A74"), SCROLL:=True
End Sub
Sub GREEN()
Application.Goto Range("A106"), SCROLL:=True
End Sub
Sub PURPLE()
Application.Goto Range("A138"), SCROLL:=True
End Sub

Needs to be pasted on every sheet? that is going to be copied and emailed over?

Many Thanks

x

Am i right in saying

Mail_Object.CreateItem(o) 'this part is like saying File (newmail)
Set OutMail = Nothing ' this part sets everything in the mail i am sending to blank
Set OutApp = Nothing ' not sure about this one <!-- / message --><!-- edit note -->

 

[Michael M]

ANY macros that need to be sent with the sheet, will need to be in the sheet module.
You will then have to re-assign the macros to the buttons.
However, the macros seem to be a fairly simple method of locating a cell, which seems a bit of a waste of effort trying to attach them !!