love_guy_1977
Board Regular
- Joined
- Aug 5, 2006
- Messages
- 111
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
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