Excel VBA Macro to Copy and Email the Filtered Data as a Attachment to a User with Outlook Email
Sub MailMyRange_User()
Dim WB As Workbook
Dim WS As Worksheet
Dim TargetFilePath As String
Dim TargetFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object
Dim SigString As String
Dim Signature As String
Dim Strbody As String
TargetFilePath = "C:\Users\TPReddy\Desktop\Tamatam\"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Strbody = "<H3><B>TEST MAIL via EXCEL MACRO</B></H3>" & _
"This is sample test mail by Macro<br>" & _
"Please donot repond to it<br>" & _
"<A href=""www.excelkingdom.blogspot.in"">Excel Kingdom</A>" & _
"<br><br><B>Thank you</B>"
Application.DisplayAlerts = False
'Copying the filtered Data range from your Data Sheet'
ActiveSheet.Range("A1").Select
Selection.AutoFilter Field:=1, Criteria1:=Array("143","123"), _
Operator:=xlFilterValues
ActiveSheet.AutoFilter.Range.Copy ' Copy all columns data in Filtered Range
'On Error Resume Next
'If Val(Application.Version) < 12 Then
' You are using Excel 2000 or 2003.
' FileExtStr = ".xls": FileFormatNum = -4143
'Else
'You are using Excel 2007 or 2010.
'FileExtStr = ".xlsx": FileFormatNum = 51
'End If
'Saving the filtered Data range Copied from your Data Sheet to New Workbook'
Workbooks.Add (xlWBATWorksheet)
ActiveWorkbook.ActiveSheet.Range("A1").PasteSpecial
ActiveWorkbook.SaveAs TargetFilePath & "Test.xlsx"
ActiveWorkbook.Close
TargetFileName = TargetFilePath & "Test.xlsx"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'Change only 'YourSignature.htm' to the name of your signature
SigString = Environ("appdata") & _
"\Microsoft\Signatures\YourSignature.htm"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
'On Error Resume Next
With OutMail
.To = "youremail@domain.com"
.CC = " "
.BCC = ""
.Subject = "Test File"
.HTMLBody = Strbody & "<br>" & Signature
.Attachments.Add (TargetFileName)
'In place of the following statement, you can use ".Display" to display the e-mail message.
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
You Should Use this Function in your Module to work Macro to Insert Signature in Your Email
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
TS.Close
End Function
----------------------------------------------------------
Tips or Notes :
In the above macro above we use .HTMLBody to add text and a Signature to the mail but what if you want to use .Body to create a plain message ?
Example :
Mail_Outlook_With_Signature_Html
Change the Strbody line to
Strbody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"
Change the .HTMLBody line to .Body = Strbody & vbNewLine & Signature
Also change the extension(htm) of the signature file named MySig.htm in the SigString to txt
Sub MailMyRange_User()
Dim WB As Workbook
Dim WS As Worksheet
Dim TargetFilePath As String
Dim TargetFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object
Dim SigString As String
Dim Signature As String
Dim Strbody As String
TargetFilePath = "C:\Users\TPReddy\Desktop\Tamatam\"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Strbody = "<H3><B>TEST MAIL via EXCEL MACRO</B></H3>" & _
"This is sample test mail by Macro<br>" & _
"Please donot repond to it<br>" & _
"<A href=""www.excelkingdom.blogspot.in"">Excel Kingdom</A>" & _
"<br><br><B>Thank you</B>"
Application.DisplayAlerts = False
'Copying the filtered Data range from your Data Sheet'
ActiveSheet.Range("A1").Select
Selection.AutoFilter Field:=1, Criteria1:=Array("143","123"), _
Operator:=xlFilterValues
ActiveSheet.AutoFilter.Range.Copy ' Copy all columns data in Filtered Range
'On Error Resume Next
'If Val(Application.Version) < 12 Then
' You are using Excel 2000 or 2003.
' FileExtStr = ".xls": FileFormatNum = -4143
'Else
'You are using Excel 2007 or 2010.
'FileExtStr = ".xlsx": FileFormatNum = 51
'End If
'Saving the filtered Data range Copied from your Data Sheet to New Workbook'
Workbooks.Add (xlWBATWorksheet)
ActiveWorkbook.ActiveSheet.Range("A1").PasteSpecial
ActiveWorkbook.SaveAs TargetFilePath & "Test.xlsx"
ActiveWorkbook.Close
TargetFileName = TargetFilePath & "Test.xlsx"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'Change only 'YourSignature.htm' to the name of your signature
SigString = Environ("appdata") & _
"\Microsoft\Signatures\YourSignature.htm"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
'On Error Resume Next
With OutMail
.To = "youremail@domain.com"
.CC = " "
.BCC = ""
.Subject = "Test File"
.HTMLBody = Strbody & "<br>" & Signature
.Attachments.Add (TargetFileName)
'In place of the following statement, you can use ".Display" to display the e-mail message.
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
You Should Use this Function in your Module to work Macro to Insert Signature in Your Email
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
TS.Close
End Function
----------------------------------------------------------
Tips or Notes :
In the above macro above we use .HTMLBody to add text and a Signature to the mail but what if you want to use .Body to create a plain message ?
Example :
Mail_Outlook_With_Signature_Html
Change the Strbody line to
Strbody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"
Change the .HTMLBody line to .Body = Strbody & vbNewLine & Signature
Also change the extension(htm) of the signature file named MySig.htm in the SigString to txt
#------------------------------------------------Thanks-------------------------------------------#
No comments:
Post a Comment
Hi User, Thank You for visiting My Blog. Please post your genuine Feedback or comments only related to this Blog Posts. Please do not post any Spam comments or Advertising kind of comments which will be Ignored.