Send email on cell click from excel

[jubilee101]

Hi Everyone,
I have an Excel tracker. I need to send an email once a particular cell is click. I have the email bit working but not the cell click action.

Email code is:

Sub CreateMail()


 


 


Dim objOutlook As Object


Dim objMail As Object


Dim rngTo As Range


Dim rngSub As Range


Dim rngMessage As Range


Dim rngAttachment As Range


 


Set objOutlook = CreateObject("Outlook.Application")


Set objMail = objOutlook.CreateItem(0)


 


With ActiveSheet


Set rngTo = .Range("H4")


Set rngSub = .Range("I4")


Set rngMessage = .Range("J4")


Set rngAttachment = .Range("K4")


End With


With objMail


.To = rngTo.Value


.Subject = rngSub.Value


.Body = rngMessage.Value


.Attachments.Add rngAttachment.Value


.Display 'Instead of .Display, you can use .Send to send the email


End With


Set objOutlook = Nothing


Set objMail = Nothing


Set rngTo = Nothing


Set rngSub = Nothing


Set rngMessage = Nothing


Set rngAttachment = Nothing
End Sub

Then for the cell click, I have: (Doesn't work - not sure how to link them either

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If Intersect(Target, Range("L4:L1000")) Is Nothing Then
      Exit Sub
   Else
      Sheet1.CreateMail
   End If


End Sub

 

[DanteAmor]

I made a small adjustment to your code.
Put all your code in the events of your sheet

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  If Not Intersect(Target, Range("L4:L1000")) Is Nothing Then
    Sheet1.CreateMail
  End If
End Sub

SHEET EVENT
Right click the tab of the sheet you want this to work, select view code and paste the code into the window that opens up. return to excel, select a cell and the macro will run

 

[jubilee101]

Thanks Dante.

So for some reason I can't get this to work at all. To double check, I right click on Sheet1 and paste the Code for CreateMail and your adjusted code into the screen that appears?

 

[jubilee101]

Hi Dante, Apologies I have that working now. Thank you.

Now I realise there is an issue with my original code

With ActiveSheet


Set rngTo = .Range("H4")


Set rngSub = .Range("I4")


Set rngMessage = .Range("J4")


Set rngAttachment = .Range("K4")


End With

How do I specify a range here instead of just row 4? So lets say i have 10 rows of data. As I click on a particular cell on each row, i want it to email the email addresses and add the attachment on that particular row.

 

[DanteAmor]

Maybe:

Sub CreateMail()
  Dim objOutlook As Object, objMail As Object, rngTo As Range, rngSub As Range
  Dim rngMessage As Range, rngAttachment As Range
  Set objOutlook = CreateObject("Outlook.Application")
  Set objMail = objOutlook.CreateItem(0)
  With ActiveSheet
    Set rngTo = .Range("H" & ActiveCell.Row)
    Set rngSub = .Range("I" & ActiveCell.Row)
    Set rngMessage = .Range("J" & ActiveCell.Row)
    Set rngAttachment = .Range("K" & ActiveCell.Row)
  End With
  With objMail
    .To = rngTo.Value
    .Subject = rngSub.Value
    .Body = rngMessage.Value
    .Attachments.Add rngAttachment.Value
    .Display 'Instead of .Display, you can use .Send to send the email
  End With
  Set objOutlook = Nothing: Set objMail = Nothing: Set rngTo = Nothing
  Set rngSub = Nothing: Set rngMessage = Nothing: Set rngAttachment = Nothing
End Sub