I am using Excel 2010 and I have this script that sends an e-mail when I run the macro but, it sends all rows, how do I get it to just send the row I filter, i.e. the row I select?
Code:
'--- Set up the Outlook objects.
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
'--- Declare our global variables to be used in each subroutine.
Dim CustomerAddress As String
Dim CustomerMessage As String
Sub MailItNow()
'--- Declare our variables.
Dim X As Integer
Dim TempCustomerAddress As String
'--- Prevent screen redraws until the macro is finished.
Application.ScreenUpdating = False
'--- Sort the addresses and names alphabetically, by the e-mail address.
'--- This is REQUIRED to prevent any duplicate addresses from
' receiving more than one e-mail.
'Columns("A:C").Select
Columns.Range("A:T").Select
'-- Selection.Sort Key1:=Range("N2"), Order1:=xlAscending, Header:=xlGuess, _
'-- OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'--- Sets which row to start searching for e-mail addresses and names.
'--- columns ("A:B")
X = 2
'--- Begin looping through all the e-mail addresses in column A until
' a blank cell is hit.
While Range("N" & X).Text <> ""
'--- These variables will be used to search for duplicates.
CustomerAddress = Range("N" & X).Text
TempCustomerAddress = CustomerAddress
'--- Increment X until a different e-mail address is found.
While TempCustomerAddress = CustomerAddress
X = X + 1
CustomerAddress = Range("N" & X).Text
Wend
'--- Add the e-mail address to a global variable.
CustomerAddress = Range("N" & X - 1).Text
'--- Add a message with the user's name to the e-mail.
'--- Customize your own message and closing here.
'--- CustomerMessage = Range("M" & X - 1).Text & "," & vbCrLf & vbCrLf _
CustomerMessage = "Notification of Works Order:" & Range("B" & X - 1).Text & vbCrLf & vbCrLf & _
"Please find details below of a new works order from Lancashire Constabulary" & vbCrLf & vbCrLf & _
"Date Logged:" & vbCrLf & Range("A" & X - 1).Text & vbCrLf & vbCrLf & _
"Site Location:" & vbCrLf & Range("C" & X - 1).Text & vbCrLf & vbCrLf & _
"Description of work:" & vbCrLf & Range("H" & X - 1).Text & vbCrLf & vbCrLf & _
"Regards" & vbCrLf & "Estates Helpdesk" & vbCrLf & _
"01772 412352" & vbCrLf & _
"HQ-ESTATESREPAIRS@lancashire.pnn.police.uk" & vbCrLf
'--- Run the subroutine to send the message.
Call SendMessage
Wend
End Sub
Sub SendMessage(Optional AttachmentPath)
'--- This is required to prevent a name which does not resolve to
' an e-mail address from hanging the app.
On Error Resume Next
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(CustomerAddress)
objOutlookRecip.Type = olTo
' Set the Subject, Body, and Importance of the message.
.Subject = "Works Order"
.Body = CustomerMessage
'.Importance = olImportanceHigh 'High importance
' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
Exit Sub
End If
Next
.Send '--- Send the message.
End With
'--- Remove the message and Outlook application from memory.
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Sub