send auto email work anniversary

[kerm007]

hello
how can my HR girls auto send email to all when its the work anniversary of some one from an excel sheet populated with the name and the anniversay date of an employee ?
Thanks

 

[Wookiee]

when i open the excel i get this
For Each rngCell In Range("tblPeeps[Name]")

Thanks

My mistake. You need to either change the formula to reflect your table's name or rename your table.

 

[Wookiee]

also how can i adjust it to be the employment birthday like happy 2 years etc ?

I'll get to work on that and get back to you!

 

[Wookiee]

I redid the whole thing, so I'll attempt to lay out the entire construction in one well-worded go. Wish me luck!

[WORKSHEET SET UP]

Cell B2 is a named range (nrToday) and its formula is

=TODAY()

The data table is named tblX with its headers on Row 3.

Column A contains employee names, Column B shows their hire dates, and Column C lists their email addresses.

Columns D and E are used to calculate whether the people have an anniversary and how many years they've been with the company.

The formula for Cell D4 is

=IF(AND(MONTH(B4)=MONTH(nrToday),DAY(B4)=DAY(nrToday)),"Anniversary","")

The formula for Cell E4 is

=DATEDIF([@Hired],nrToday,"Y")

[CODE SETUP]

From the VB Editor, paste this code into the ThisWorkbook object:

Option Explicit

Private Sub Workbook_Open()

Dim rngCell     As Range
Dim strMessage  As String


For Each rngCell In Range("tblX[Name]")

  If rngCell.Offset(0, 3) = "Anniversary" Then

    strMessage = "Congratulations, yo!<br><br>" & _
      "We are so totally chuffed to have " & _
      "you working with us.<br><br>Happy " & _
      Addth(rngCell.Offset(0, 4).Value) & _
      " Work Anniversary!"

    Call Email _
      (rngCell.Offset(0, 2), "Happy Anniversary!", strMessage)

    strMessage = ""

  End If

Next rngCell

End Sub

And paste these codes into Module1:

Option Explicit

Function Addth(pNumber As String) As String
'Updateby20141027
'Function Posted At:
'https://www.extendoffice.com/documents/excel/2167-excel-convert-cardinal-to-ordinal.html


Select Case CLng(VBA.Right(pNumber, 1))

  Case 1:  Addth = pNumber & "st"
  Case 2:  Addth = pNumber & "nd"
  Case 3:  Addth = pNumber & "rd"
  Case Else: Addth = pNumber & "th"

End Select

Select Case VBA.CLng(VBA.Right(pNumber, 2))

  Case 11, 12, 13:  Addth = pNumber & "th"

End Select

End Function


Sub Email _
  (sTo As String, sSub As String, _
   sHTML As String, Optional sAttach As Variant, _
   Optional sAction As String = "Display", _
   Optional sCCs As String, Optional sSender As String)
'v1.49   31 Mar 2023
'https://www.RONDEBRUIN.nl/win/s1/outlook/signature.htm
'with appreciation to ChatGPT for help with the attachment
'logic


'Declare Variables
Dim lngLoop  As Long
Dim olApp    As Object
Dim olMsg    As Object
Dim arrEh    As Variant

'Create Email Message
Set olApp = CreateObject("Outlook.Application")
Set olMsg = olApp.CreateItem(0)

On Error Resume Next

  Set olApp = GetObject(, "Outlook.Application")
 
  If olApp Is Nothing Then _
    Set olApp = CreateObject("Outlook.Application")
 
  Set olMsg = olApp.CreateItem(0)
 
  With olMsg
 
    .Display

    If sSender <> "" Then

      .SentOnBehalfOfName = sSender

    End If

    .To = sTo
    .CC = sCCs
    .HTMLBody = sHTML & .HTMLBody
    .Subject = sSub

    If Not IsMissing(sAttach) And Not IsNull(sAttach) Then

      If Not IsArray(sAttach) Then

        .Attachments.Add sAttach
        GoTo Utah

      End If
  
      For lngLoop = LBound(sAttach) To UBound(sAttach)
    
        .Attachments.Add sAttach(lngLoop)
    
      Next lngLoop

Utah:
    End If
  
    If sAction = "Display" Then
  
      .Display
  
    ElseIf sAction = "Send" Then
  
      .Send
  
    End If
 
  End With
On Error GoTo 0

'Clear Set Variables
Set olApp = Nothing
Set olMsg = Nothing


End Sub

I tested it out and it all worked, so once you plug in your employee data, save and close the file, it should work nicely the next time someone opens the file.

 

[kerm007]

im confuse about d2 or d4 and e2 or e4
i have to test

 

[Wookiee]

im confuse about d2 or d4 and e2 or e4
i have to test

Sorry, in my illustration I listed those cells as D2 and E2 when they should have read D4 and E4.

The table will automatically fill the column with whatever formula you enter, so that's why I only provided the formulas for D4 and E4; once you enter the formula in one cell, the table column will maintain that formula for each new record you enter.

 

[kerm007]

ok i will try to understand it
let you know when i can work on it

 

[kerm007]

the code in e4 doesn't work i have error

 

[Wookiee]

the code in e4 doesn't work i have error
View attachment 93662

I have to assume there's something wrong with the way your table is set up. Can you confirm that all the headers are correct (especially B3)?

A3: Name
B3: Hired
C3: Email
D3: Check
E3: Anniversary

 

[kerm007]

i also get invalid name error in D4

 

[kerm007]

ok i change head in B4 but i have invalid name on d4 and e4
but i advance