Need help getting excel to send automatic emails based on cell value

Ticket Spreadsheet.xlsx

I have looked at various threads and whilst i can find similar solutions none are working

I want a ticketing system that automatically sends an email containing references to the address in column I when the corresponding cell B is changed to 'IN PROGRESS' then another (different email) when it is changed to resolved.

I want a MsgBox to appear asking: 'Would you like to email the customer?' Y/N so i can choose not to send the email. i want excel to just directly send the email via the exchange network IF POSSIBLE and not open outlook email; however i would be happy to run it through Outlook if it makes this work.



So when column B changes to 'IN PROGRESS' an message box appears.

If Yes is clicked an email is sent:

Email Subject: Ticket Number [COLUMN A] for [COLUMN J]

Email Msg: Thanks for returning your [COLUMN J] your ticket number is [COLUMN A] please quote this on all future emails. We aim to resolve this by [COLUMN C + 7 DAYS]. Thank You.


When column B is changed to 'RESOLVED' then it should send another email out:

Email Subject: Ticket Number [COLUMN A] for [COLUMN J] - RESOLVED

Email Msg: Your issue with your [COLUMN J], ticket number [COLUMN A] has now been resolved. Thank You.


My code is probably miles away from being right:

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim lngResponse As Long
    Dim URL As String, strEmail As String, strSubject As String, strBody As String
    If Left(Target.Address, 2) = "$B" Then
        If Target.Value =”IN PROGRESS”. Value Then
            lngResponse = MsgBox("Would you like to email the customer?", vbYesNo)
            If lngResponse = vbYes Then
                strEmail = Range("$I" & Right(Target.Address, 2)).Value
                strSubject = "Ticket Number " & Range("$A" & Right(Target.Address, 2)).Value & "for " & Range("$J" & Right(Target.Address, 2)).Value
                strSubject = Application.WorksheetFunction.Substitute(strSubject, " ", "%20")
               strBody = “Thanks for returning your “  & Range("$J" & Right(Target.Address, 2)).Value & “your ticket number is“ & Range("$A" & Right(Target.Address, 2)).Value & “please quote this on all future emails. We aim to resolve by “& Range("$D" & Right(Target.Address, 2)).Value & “. Thank You.”
strURL = "mailto:" & strEmail & "?subject=" & strSubject
                ShellExecute 0&, vbNullString, strURL, vbNullString, vbNullString, vbNormalFocus
debugs:
If Err.Description <> "" Then MsgBox Err.Description
            End If
        End If
    End If
Exit Sub
        If Target.Value =”RESOLVED”. Value Then
            lngResponse = MsgBox("Would you like to email the customer?", vbYesNo)
            If lngResponse = vbYes Then
                strEmail = Range("$I" & Right(Target.Address, 2)).Value
                strSubject = "Ticket Number " & Range("$A" & Right(Target.Address, 2)).Value & "for " & Range("$J" & Right(Target.Address, 2)).Value & “- RESOLVED”
                strSubject = Application.WorksheetFunction.Substitute(strSubject, " ", "%20")
               strBody = “Your issue with your “  & Range("$J" & Right(Target.Address, 2)).Value & “, ticket number “ & Range("$A" & Right(Target.Address, 2)).Value & “has now been resolved. Thank You.”
strURL = "mailto:" & strEmail & "?subject=" & strSubject
                ShellExecute 0&, vbNullString, strURL, vbNullString, vbNullString, vbNormalFocus
debugs:
If Err.Description <> "" Then MsgBox Err.Description
            End If
        End If
    End If
End Sub

Thanks in advance.

the first code goes in the worksheet project editor area and the second create a module and put that in there...I suppose you can put them both in the worksheet project area...

NOTE: you need to fill in the FROM email address and the SMTP server name....

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim ValRtn As Integer
    
    If Target.Column = 2 And Target.Value = "In Progress" Then
        ValRtn = MsgBox("Do you want to send an In Progress Email", vbYesNo)
        If ValRtn = vbYes Then
            SendEmail "IN PROGRESS", Cells(Target.Row, 1).Value, Cells(Target.Row, 3).Value, Cells(Target.Row, 10).Value, Cells(Target.Row, 9).Value
        End If
    End If
    
    If Target.Column = 2 And Target.Value = "Resolved" Then
        ValRtn = MsgBox("Do you want to send an Resolved Email", vbYesNo)
        If ValRtn = vbYes Then
            SendEmail "RESOLVED", Cells(Target.Row, 1).Value, Cells(Target.Row, 3).Value, Cells(Target.Row, 10).Value, Cells(Target.Row, 9).Value
        End If
    End If

End Sub

Sub SendEmail(MessageType, TicketNum, MyDate, MyItem, EmailAddress)

    Dim EmailTo As String, MessageBody As String, SubjectLine As String
    Dim objmessage As Object
    Dim i As Integer

    Set objmessage = CreateObject("CDO.Message")
    objmessage.from = ""       'INSERT VALID EMAIL ADRESS HERE"
    objmessage.bcc = ""
    objmessage.To = EmailAddress
    'objmessage.CC = CCList

    objmessage.Subject = "Ticket Number: " & TicketNum & " for " & MyItem & " is " & MessageType

    Select Case UCase(MessageType)
        Case "IN PROGRESS"
            MessageBody = "Thanks for Returning your " & MyItem & ". Your ticket number is: " & TicketNum & ". Please quote this on all future emails. We aim to resolve this by: " & MyDate + 7 & ". Thank You."
        Case "RESOLVED"
            MessageBody = "Your issue with your " & MyItem & ". Ticket number: " & TicketNum & " has now been resolved. Thank You."
    End Select
    
    objmessage.textbody = MessageBody

    objmessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objmessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = ""  'INSERT VALID SMTP SERVER NAME HERE
    objmessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    objmessage.Configuration.Fields.Update
    objmessage.Send
    
End Sub

the recipient address means it's not a valid email address.....this does assume (sorry about that) that you are using a local email SMTP Server and a valid user on the that SMTP Server....you don't need a password because I assumed you where logged on as that user....the SMTP system should figure that out....mine does anyways....

So, Are you logging on as the user that is sending the email?

add these two lines in the SendEmail module toward the bottom with the other objmessage stuff

 
    objmessage.configuration.Fields.Item _
    ("http://schemas.Microsoft.Com/cdo/configuration/sendusername") = "username"
    objmessage.configuration.Fields.Item _
    ("http://schemas.Microsoft.Com/cdo/configuration/sendpassword") = "password"