Email macro

[gee83]

Hi there,

Wondering if someone can assist with a relatively simple macro I am working on.

I two cells on a spreadsheet where the user can enter a value (0 or above). When they enter a value of 1 or greater I want a mail to be sent to them so I can provide them with further instructions based on their input. They enter their email address on the sheet which is where the email will be sent to. I have been using the Worksheet_Change macro along with a mail macro but having difficulty getting them to work as required, below is my code. The cells G32 and 33 are the cells the user enters a number in (could be either cells or both cells) and triggers the mail to be sent, with their email address being entered first in cell E10.

At present the macro is running without error but is triggered when any cell on the worksheet has text entered. The macro triggers outlook to create an email but it does not seem to be picking up the email address in cell E10 and so doesnt actually send. I would be grateful for any help.

Private Sub Worksheet_Change(ByVal Target As Range)
If Range("G32").Value > 0 Then
        Call Message
Call Mail_small_Text_Outlook
    ElseIf Range("G33").Value > 0 Then
        Call Message
Call Message
Call Mail_small_Text_Outlook
End If
End Sub


Sub Message()
MsgBox "message prompt here"
End Sub


Sub Mail_small_Text_Outlook()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "Hi There," & vbNewLine & vbNewLine & _
              "blah blah blah." & vbNewLine & vbNewLine & _
              "data: " & vbNewLine & _
              "data: " & vbNewLine & _
              "data: " & vbNewLine & _
              "data: " & vbNewLine & vbNewLine & _
              "data: " & vbNewLine & vbNewLine & _
              "Thanks" & vbNewLine & vbNewLine & _
              
              

              
    On Error Resume Next
    With OutMail
    
        .To = ActiveCell.e10
        .CC = ""
        .BCC = ""
        .Subject = "subject line here"
        .Body = strbody
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

[AlvaroSiza]

Perhaps change the

.To = ActiveCell.e10

to

.To = Range("E10")

Just while you are testing, you can change the

.Send

to

.Display

to verify that the correct e-mail address is being entered into the "To" field within Outlook.

In total:

Sub Mail_small_Text_Outlook()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim strTo As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "Hi There," & vbNewLine & vbNewLine & _
              "blah blah blah." & vbNewLine & vbNewLine & _
              "data: " & vbNewLine & _
              "data: " & vbNewLine & _
              "data: " & vbNewLine & _
              "data: " & vbNewLine & vbNewLine & _
              "data: " & vbNewLine & vbNewLine & _
              "Thanks" & vbNewLine & vbNewLine & _

    strTo = Range("E10")

    On Error Resume Next
    With OutMail
    
        .To = strTo        
        .CC = ""
        .BCC = ""
        .Subject = "subject line here"
        .Body = strbody
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

[gee83]

Hi There,

Thanks for your help, the email is now sending to the correct recipient which is great. The only issue is that the email macro is triggered when entering data into any cell on the worksheet. I only require cells G32 and G33 to be the cells that trigger the mail macro. I think it must be an issue with the first piece of code. I have tried to specify these cells but the macro is running when any cell on the sheet is changed, any ideas of how to solve this issue?

Private Sub Worksheet_Change(ByVal Target As Range)
If Range("G32").Value > 0 Then
        Call Message
Call Mail_small_Text_Outlook
    ElseIf Range("G33").Value > 0 Then
        Call Message
Call Message
Call Mail_small_Text_Outlook
End If
End Sub

[AlvaroSiza]

Give this a go...

Private Sub Worksheet_Change(ByVal Target As Range)

   If Target.Address = "$G$32" Or Target.Address = "$G$33" Then
      If IsEmpty(Range("G32")) And IsEmpty(Range("G33")) Then
         Exit Sub
      ElseIf Range("G32") > 0 Or Range("G33") > 0 Then
         Call Message
         Call Mail_small_Text_Outlook
      End If
   End If

End Sub

[gee83]

Give this a go...

Private Sub Worksheet_Change(ByVal Target As Range)

   If Target.Address = "$G$32" Or Target.Address = "$G$33" Then
      If IsEmpty(Range("G32")) And IsEmpty(Range("G33")) Then
         Exit Sub
      ElseIf Range("G32") > 0 Or Range("G33") > 0 Then
         Call Message
         Call Mail_small_Text_Outlook
      End If
   End If

End Sub

Works perfectly! thanks for your prompt help, much appreciated!