This is the other code which I tested out.
Dim OutlookApp As Object
Dim NewMail As Object
Dim ActShtName As String
Dim FileFullPath As String
.ScreenUpdating = False
.EnableEvents = False
'Copying the Active Sheet data
ActShtName = ActiveSheet.Name
'Saving the Active sheet data into a new workbook with Active Sheet name_Today date
Application.CutCopyMode = False
ActiveSheet.Name = ActShtName
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Environ("vbaexcelcodes") & ActShtName & "_" & Format(Now, "dd-mmm-yyyy") & ".xlsx"
'Storing the Saved file(which we used for attachment later) path into a Variable
FileFullPath = ActiveWorkbook.Path & "" & ActiveWorkbook.Name
Application.DisplayAlerts = True
'Setting up the objects of Outlook Application and New Email
Set OutlookApp = CreateObject("Outlook.Application")
Set NewMail = OutlookApp.CreateItem(olMailItem)
'Set NewMail = OutlookApp.CreateItem(0)
'Inserting Signature in Email Boday ; Change only 'YourSignature.htm' to the name of your Signature
SigString = Environ("appdata") & "\Microsoft\Signatures\Tamatam.htm"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Signature = ""
'Selecting your desired Email Account for Sending From Account
'If the account is not in your profile, Then you need to use SentOnBehalfOfName
For I = 1 To OutlookApp.Session.Accounts.Count
If OutlookApp.Session.Accounts.Item(I) = "[email protected]" Then
'--MsgBox OutlookApp.Session.Accounts.Item(I) & " : This is account number " & I
Acn_No = I
'Defining the Email Body Message
Strbody = "<H3><B>TEST MAIL via EXCEL MACRO</B></H3>" & _
"This is Sample Test Email by Macro<br>" & _
"Please donot repond to It<br>" & _
"<A href=""https://excelkingdom.blogspot.in/"">Excel Kingdom</A>"
On Error Resume Next
'Opening a New Email to Send
.TO = "" 'Your Email Id here
.CC = ""
.BCC = ""
.Subject = "Test Message" 'Your Email Subject here
'.Body = "This Your Email Boday ; '--You can use below one as well
.HTMLBody = Strbody & "<br>" & "<br>" & "<B>Thank you</B>" & "<br>" & Signature
.Attachments.Add FileFullPath '-- Full Path of the Attachment where it is saved.
.SentOnBehalfOfName = OutlookApp.Session.Accounts.Item(Acn_No)
'--You can use below one as well
'.SentOnBehalfOfName = "[email protected]m"
'.SendUsingAccount = OutlookApp.Session.Accounts.Item(Acn_No)
.Display '--Use .Display to show you the Email before sending it.
On Error GoTo ErrMsg:
' Since mail has been sent with the attachment.You can kill the Source file if not required
' Set nothing to the objects created.
Set NewMail = Nothing
Set OutlookApp = Nothing
' Now set the application properties back to true.
.ScreenUpdating = True
.EnableEvents = True
MsgBox "Activesheet as Email Attchment Sent Successfully", vbOKOnly, "Job Done"
'The Function to Look and Get the Email Signature; Calls into above Macro
Function GetBoiler(ByVal SigFile As String) As String
Dim FSO As Object
Dim TS As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TS = FSO.GetFile(SigFile).OpenAsTextStream(1, -2)
GetBoiler = TS.readall