Search code examples
excelvba

Do not repeat previously completed action


I'm using the below code to auto-generate an email based on changes made to column F.

Unfortunately, once an email is sent and I close/reopen the spreadsheet, it duplicates the email.

When re-opening the spreadsheet I want previousValue to be updated already. So when I open a sheet without making edits, and hit save, it doesn't fire off another email.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim previousValue As Variant
    Dim currentValue As Variant
    Dim outlookApp As Object
    Dim outlookMail As Object
    
    ' Set the worksheet where your data is located
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Replace "Sheet1" with your sheet name
    
    ' Find the last row with data in column F
    lastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row
    
    ' Initialize the previous value
    previousValue = ws.Cells(2, "F").Value ' Assuming data starts from row 1
    
    ' Loop through the rows starting from the second row (assuming headers are in the first row)
    For i = 2 To lastRow
            
        ' Check if there's a change in column F
        If currentValue <> previousValue Then
            
            ' Create an Outlook email object
            Set olApp = CreateObject("Outlook.Application")
            Set olMail = olApp.CreateItem(0)
            
            ' Set the recipient's email address from column B
            olMail.To = ws.Cells(i, "B").Value
            
            ' Set the subject (customize as needed)
            olMail.Subject = "Change Detected: " & ws.Cells(i, "A").Value
            
            ' Set the email body from your template (customize as needed)
            olMail.Body = "Dear Recipient," & vbCrLf & _
                          " " & vbCrLf & _
                          "A change has been detected for " & ws.Cells(i, "A").Value & vbCrLf & _
                          " " & vbCrLf & _
                          "Details: " & ws.Cells(i, "C").Value & vbCrLf & _
                          " " & vbCrLf & _
                          "Your incident has been escalated to the EBMS Technical Team for additional triage and investigation. Should they require additional information to diagnose the incident, they may reach out to you using the information you provided to the EBMS Support Team." & vbCrLf & _
                          " " & vbCrLf & _
                          " " & vbCrLf & _
                          "Best regards," & vbCrLf & _
                          "Site Support"
            
            ' Send the email
            olMail.Send
            
            ' Update the previous value
            previousValue = currentValue
        End If
    Next i
    
    ' Release Outlook objects
    Set olMail = Nothing
    Set olApp = Nothing
End Sub

Solution

  • When running your check, store the Col F value in another column for later comparison: if you find a difference between the current and stored values then send a mail and update the stored value.