Macro to send automatic emails on birthday meets with today

[shekar goud]

Hi All,

iam just trying to write a macro which will automatically send email depending on one's birthday.

iam able to send the email but iam stucked at calcualtions of days could someone please help me.

iam attaching an S/S

Sub shekartestmail()
    Dim ol As Object, myItem As Object
  
    Set ol = CreateObject("outlook.application")
    For Each AddCell In Worksheets("Sheet1").Range("B2:B100")
    Set myItem = ol.CreateItem(olMailItem)
        myItem.To = AddCell.Value
        myItem.Subject = "Hello There..."
        myItem.Body = "Hello, " & AddCell.Offset(0, 1).Value & "." & Chr(13) & Chr(13)
        myItem.Body = myItem.Body & "Many Happy returns of the day." & Chr(13)
        myItem.Body = myItem.Body & "Thanks for all your Support." & Chr(13) & Chr(13)
        myItem.Body = myItem.Body & "Shekar Thonta," & Chr(13)
        myItem.Body = myItem.Body & "Senior Analyst HR," & Chr(13)
        myItem.Body = myItem.Body & "India Service Centre" & Chr(13)
        myItem.Body = myItem.Body & "ManiKonda,Gachibowli" & Chr(13)
        myItem.Body = myItem.Body & "Hyderabad-500001" & Chr(13)
        myItem.Body = myItem.Body & "Internal Message" & Chr(13)
                SendIt = MsgBox("Here's the message to " & myItem.To & Chr(13) & Chr(13) & myItem.Body, vbOKCancel)

        If SendIt = vbOK Then
        myItem.Send
        Else:
        myItem.Delete
        MsgBox "Not sent"
        End If
    Next AddCell
    Set ol = Nothing
Workbook.Close
End Sub

Thanks for all your help

Regards,
Shekar.

[DonkeyOte]

Without looking at the code in depth in general you have a few options the most obvious of which would be to check Day & Month of birth date to current Date, ie:

If Format(AddCell.Offset(,1),"ddmm") = Format(Date,"ddmm") Then
    '...distribute email...
End If

[shekar goud]

Hi Donkeyote,

Infact,iam really at the level of intermidate in excel...if you would have seen my excel would look like that will this work for me.


Thanks for your help.

Regards,
Shekar.

[shekar goud]

Hi,

Thanks to donkeyote for the help.

iam just trying how to make out the macro but unable to do it just because i have no idea of using the mailing functions...could someone please help.

i have tried something which is not working..below is my new code

Sub justmail()
Dim LDate As String
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

  
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon

LDate = date
On Error GoTo cleanup
    For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
            Format(AddCell.Offset(, 2), "ddmm") = Format(LDate, "ddmm") Then


Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = cell.Value
                .Subject = "Reminder"
                .Body = "Dear " & Cells(cell.Row, "C").Value _
                      & vbNewLine & vbNewLine & _
                        "Many Happy Returns of the Day " & _
                        .send
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If
    Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub