VBA code to send email notification.

[tcaslv]

Hello all.

I am working on a workbook where I have inventoried items at my work place. This workbook contains quite a few pages and also over a 100 items per page. The idea with this was to have someone update the inventory and then when they save the file, it sends an email to the person responsible for them to order the items needed. The code I used is as follows.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Outlook As Object, EMail As Object
Set Outlook = CreateObject("Outlook.Application")
Set EMail = Outlook.CreateItem(0)
With EMail
    .To = [EMAIL="fakeemail@fakecompany.com"]fakeemail@fakecompany.com[/EMAIL]    '. Change the email in quotes if responsibilities change
    .CC = ""
    .BCC = ""
    .Subject = "Pipe Fittings "
    .Body = "Has been updated at  L:\Lab Supplies\Pipe Fittings"
    .Send '.Send to skip preview .Display to preview email
End With

Set EMail = Nothing
Set Outlook = Nothing
End Sub

This code works perfect for letting the person know the file is updated. But anyone with ADD would have looked over the file and not find the items that are low, even with conditional formating to where I have everything color coded per value.

What I want to do is add to this code of what cell was changed on a particular tab in the file. Is that possible?

I would hope that it would put it in the body of the email like it does with letting the person know what inventory was updated. If not is there a code that creates a new tab in the workbook tracking changes?

There was a code I tried before to where it would notify what cell was changed on the sheet, but the way it was structured, it would nag every instance a cell was clicked on the sheet.

 

[Logit]

.
Paste this into ThisWorkbook module :

Option Explicit


Dim vOldVal 'Must be at top of module


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)


Dim bBold As Boolean




If Target.Cells.Count > 1 Then Exit Sub
If ActiveSheet.Name = "Pricing" Then Exit Sub


'On Error Resume Next


    With Application
         .ScreenUpdating = False
         .EnableEvents = False


    End With


    If IsEmpty(vOldVal) Then vOldVal = "Empty Cell"
    bBold = Target.HasFormula
        With Sheets("Tracker")
            '.Unprotect Password:="Secret"
                If .Range("A1") = vbNullString Then
                    .Range("A1:H1") = Array("Cell Changed", "Old Value", _
                        "New Value", "Old Formula", "New Formula", "Time of Change", "Date of Change", "User")
                End If


            With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
                  .Value = ActiveSheet.Name & " : " & Target.Address
                  .Offset(0, 1) = vOldVal
            With .Offset(0, 2)
              If bBold = True Then
                .ClearComments
                .AddComment.Text Text:= _
                     "NOTE :" & Chr(10) & "" & Chr(10) & _
                        "Bold values are the results of formulas"


              End If
                .Value = Target
                .Font.Bold = bBold
                
            End With
                .Offset(0, 3) = Time
                .Offset(0, 4) = Date
                .Offset(0, 5) = Application.UserName
            End With
            .Cells.Columns.AutoFit
            '.Protect Password:="Secret"
        End With


    vOldVal = vbNullString


    With Application
         .ScreenUpdating = True
         .EnableEvents = True
    End With
On Error GoTo 0


'MsgBox "There was a change to this sheet !"
End Sub




Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    vOldVal = Target
End Sub


Private Sub test()
    Application.EnableEvents = True
End Sub

This will track changes on ALL sheets within the workbook.

NOTE: You must have one sheet named "Tracker" where the log is maintained. The sheet Tracker can be made hidden if necessary.

 

[tcaslv]

*high five* thank you Logit. Worked like a charm.

For anyone else wanting this feature, ill paste the whole thing, and all you have to do is fill in your information where as needed.

*Must be placed in "ThisWorkbook" tab*

Option Explicit

'Must be at top of module

Dim vOldVal

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim bBold As Boolean
 

If Target.Cells.Count > 1 Then Exit Sub
If ActiveSheet.Name = "Pricing" Then Exit Sub

'On Error Resume Next

    With Application
         .ScreenUpdating = False
         .EnableEvents = False

    End With

    If IsEmpty(vOldVal) Then vOldVal = "Empty Cell"
    bBold = Target.HasFormula
        With Sheets("Tracker")
            '.Unprotect Password:="Secret"
                If .Range("A1") = vbNullString Then
                    .Range("A1:H1") = Array("Cell Changed", "Old Value", _
                        "New Value", "Old Formula", "New Formula", "Time of Change", "Date of Change", "User")
                End If

            With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
                  .Value = ActiveSheet.Name & " : " & Target.Address
                  .Offset(0, 1) = vOldVal
            With .Offset(0, 2)
              If bBold = True Then
                .ClearComments
                .AddComment.Text Text:= _
                     "NOTE :" & Chr(10) & "" & Chr(10) & _
                        "Bold values are the results of formulas"

              End If
                .Value = Target
                .Font.Bold = bBold
                
            End With
                .Offset(0, 3) = Time
                .Offset(0, 4) = Date
                .Offset(0, 5) = Application.UserName
            End With
            .Cells.Columns.AutoFit
            '.Protect Password:="Secret"
        End With

    vOldVal = vbNullString

    With Application
         .ScreenUpdating = True
         .EnableEvents = True
    End With
On Error GoTo 0

'MsgBox "There was a change to this sheet !"
End Sub


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    vOldVal = Target
End Sub

Private Sub test()
    Application.EnableEvents = True
End Sub

' Above this comment. This will track changes on ALL sheets within the workbook.
'NOTE: You must have one sheet named Tracker



Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Outlook As Object, EMail As Object
Set Outlook = CreateObject("Outlook.Application")
Set EMail = Outlook.CreateItem(0)
With EMail
    .To = putemailofrecipient@youremailhere.com  ' email must be in quotes. can add as many email addresses as you want for some reason it still hyperlinks it in code format. 
    .CC = ""
    .BCC = ""
    .Subject = "Add any text for the subject of the email inbetween the quotes here"
    .Body = "Add any text you want to be said in the body of the email inbetween the quotes here"
    '.Attachments.Add ActiveWorkbook.FullName ' To add active Workbook as attachment, i have found that this sometimes doesnt give the current saved workbook if on network. 
    '.Attachments.Add "C:\Test.xlsx" ' To add other files just use path, Excel files, pictures, documents pdf's ect.
    .Send  '.Send to skip preview .Display to preview email.
            ' .Display  This gives you the option to alter the email before sending.
            ' .Send  This will automatically send the email with out preview.
            
End With

Set EMail = Nothing
Set Outlook = Nothing
End Sub

 

[Logit]

You are welcome.