Help to combine two sending email into better one (VBA included)

[love_guy_1977]

Dear, Sir,

I'm have two VBA code to send email thru Excel.

VBA1 is sending many email at once (ie. each sheet to one email) by using Array techniques.
Sheet ABC1 to [ABC1@gmail.com] & ABC2 to [ABC2@gmail.com] & so on
But for each sending, it will appear windows massage for security that have the option of Allow / Deny / Help.

VBA2 is sending only current sheet to an receiver written on the VBA itself. The nice thing here is that NO SECURITY MSG will appear.

So how can we combine the two method into one VBA as follow:
From VBA1, we need the ability to send each sheet to each email.
From VBA2, we need the ability that NOT asking you for security.


======================================
VBA1:
======================================

Sub Mail_Sheets()
'Working in 97-2007
Dim wb As Workbook
Dim Shname As Variant
Dim Addr As Variant
Dim N As Integer
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long

Shname = Array("ABC1", "ABC2", "ABC3", "ABC4")
Addr = Array("ABC1@gmail.com", "ABC2@gmail.com", "ABC3@gmail.com", "ABC4@gmail.com")
If Val(Application.Version) >= 12 Then
'You run Excel 2007
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You run Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
End If

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

TempFilePath = Environ$("temp") & "\"

'Create the new workbooks/Mail it/Delete it
For N = LBound(Shname) To UBound(Shname)

TempFileName = "Your pay slip for " & " " & Format(Now, "mmmm-yyyy")

ThisWorkbook.Sheets(Shname(N)).Copy
Set wb = ActiveWorkbook

With wb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormatNum
On Error Resume Next
.SendMail Addr(N), _
"Pay slip for the month"
On Error Resume Next
.Close SaveChanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

Next N

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








======================================
VBA2:
======================================


Sub EmailActiveSheetWithOutlook()

Dim oApp, oMail As Object, _
tWB, cWB As Workbook, _
FileName, FilePath As String

Application.ScreenUpdating = False

'Set email id here, it may be a range in case you have email id on your worksheet

Mailid = "ABC1@gmail.com"

'Write your email message body here , add more lines using & vbLf _ at the end of each line

Body = "Please find enclosed " & vbLf _
& vbLf _
& "Thanks & Regards"


'Copy Active Sheet and save it to a temporary file

Set cWB = ActiveWorkbook
ActiveSheet.Copy

Set tWB = ActiveWorkbook
FileName = "Temp.xls" 'You can define the name
FilePath = Environ("TEMP")

On Error Resume Next
Kill FilePath & "\" & FileName
On Error GoTo 0
Application.DisplayAlerts = False
tWB.SaveAs FileName:=FilePath & "\" & FileName, FileFormat:=56
Application.DisplayAlerts = True

'Sending email through outlook

Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
.To = Mailid
.Subject = "Update Message Subject here"
.Body = Body
.Attachments.Add tWB.FullName
.send
End With

'Delete the temporary file and restore screen updating

tWB.ChangeFileAccess Mode:=xlReadOnly
Kill tWB.FullName
tWB.Close SaveChanges:=False
cWB.Activate
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing

End Sub




Thank you

 

[ziad alsayed]

hope this can help

http://www.rondebruin.nl/mail/prevent.htm

 

[love_guy_1977]

hope this can help

http://www.rondebruin.nl/mail/prevent.htm

Didn't help me
Any body can help please?

Thank you