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

 

[vaskov17]

If Weekday(Now()) = 2 Then
        TempFileName = ws.Range("O" & i).Value & " " & Format(Now() - 3, "dd-mmm-yy")
    Else
        TempFileName = ws.Range("O" & i).Value & " " & Format(Now(), "dd-mmm-yy")
    End If

 

[Siyanna]

If Weekday(Now()) = 2 Then
        TempFileName = ws.Range("O" & i).Value & " " & Format(Now() - 3, "dd-mmm-yyyy")
    Else
        TempFileName = ws.Range("O" & i).Value & " " & Format(Now()[COLOR=red]-1[/COLOR], "dd-mmm-yyyy")
    End If

Hi,

with the code above, would i be right to change the ad the - 1?

So if Now is a monday then give me date of previous Friday else if today is Tuesday then give me Yesterdays date or if today is Friday then give me Thursdays date. So basically each day the code is run for the previous day however if run on a monday then give previous Friday. Your code works fine but i was just wondering if it was ok to add the - 1 for the else part to give me the previous days date.

Is the amended Code OK?

TempFilePath = Environ$("temp") & "\"
If Weekday(Now()) = 2 Then
TempFileName = ws.Range("O" & i).Value & " " & Format(Now() - 3, "dd-mmm-yy")
Else
TempFileName = ws.Range("O" & i).Value & " " & Format(Now() [COLOR=red]- 1[/COLOR], "dd-mmm-yy")
End If
FileExtStr = ".xlsm"
ActiveWorkbook.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Rest of code....

Thank You

 

[vaskov17]

Shouldn't be a problem