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]

If you set up your spreadsheet something along the lines of what I have prepared, you can do that.

First, I created a named range (a cell with the TODAY formula in it so it will always reflect the current date).

Next, I made a table with employee names, dates of birth, email addresses, and an extra column to identify any birthday people. Here's the formula for comparing birthdates:

=IF(AND(MONTH(B4)=MONTH(nrToday),DAY(B4)=DAY(nrToday)),"Birthday person!","")

Next, I crafted this macro which will launch upon opening the file:

Private Sub Workbook_Open()

Dim rngCell As Range

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

  If rngCell.Offset(0, 3) = "Birthday person!" Then

    Call Email _
      (rngCell.Offset(0, 2), "Happy Birthday!", "For you're a jolly good fellow, folderol lorem ipsum!")

  End If

Next rngCell

End Sub

You will need to either add a code module or include this macro in your existing one for the previous code to 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
'Crafted by Ron DeBruin, Wookiee at MrExcel, and ChatGPT
'https://www.RONDEBRUIN.nl/win/s1/outlook/signature.htm



'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

 

[kerm007]

hello thanks
i did one with instruction but its not working so far
will continue to test
Thanks

 

[Wookiee]

hello thanks
i did one with instruction but its not working so far
will continue to test
Thanks

I re-read my message and it occurred to me that I failed to mention that the Workbook_Open macro needs to be put in the worksheet itself, not the code module. I hope that helps.

 

[Joe4]

I re-read my message and it occurred to me that I failed to mention that the Workbook_Open macro needs to be put in the worksheet itself, not the code module. I hope that helps.

To be clear, it needs to go in the "ThisWorkbook" module, not any of the Sheet modules or in any General module that you insert.

 

[kerm007]

ok i insert formula into the B1,2 cell
the first vba code into this workbook
where do i insert the second VBA?
for now even the date is not working
Thanks helping

 

[kerm007]

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

 

[Wookiee]

I apologize for my poorly worded response previously. I meant workbook but typed worksheet like a dipsheet.

I hope this helps clarify the location of the codes.

 

[kerm007]

i will check thanks for all this

 

[kerm007]

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

Thanks