If, else, then code

Please suggest me a code for the following:

All the mails should be send once daily at the first time of opening the file only and not the second time the file is opened in a day.

mail1 & mail2:

If the remark in column ‘ad’ is ‘send mail’ then only the mail should be deliver otherwise not.

mail3:

If the remark in column ‘ac’ is “-” Then send mail.

mail4:

If the remark in column ‘ac’ is “Expired” Then send mail4 mail only once and then stop sending mail in future.

Thanking you in anticipation.

Mukesh

Dear Fredlo2010,
Thank you for your positive response to solve my problem. Now I’m optimistic that my problem will be solved at the earliest. As per your suggestion I have added auxiliary columns to create condition base on that column. I’m mentioning the conditions for macros as follows:

INSTRUCTIONS FOR SENDING MAILS

The outlook open, anniversary1, anniversary2, anniversary3 and anniversary4 macro should run once a day only at the first opening of the file and not after that till next day first opening the file.

Case1:

Anniversary1 macro should run on the day of birthday only which is in column ‘p’
If the remark in column ‘w’ is ‘Sanctioned’ then the mail should be delivered
If the remark in column ‘w’ is ‘Expired’ then the mail should not be delivered

Case 2:

Anniversary2 macro should run on the day of marriage anniversary only which is in column ‘v’
If the remark in column ‘w’ is ‘Sanctioned’ then the mail should be delivered
If the remark in column ‘w’ is ‘Expired’ then the mail should not be delivered

Case 3:

Anniversary3 macro should run on the day of birthday anniversary of spouse only which is in column ‘ac’
If the remark in column ‘ae’ is ‘-’ then the mail should be delivered
If the remark in column ‘ae’ is ‘Expired’ then the mail should not be delivered

Case 4:

Anniversary4 macro should run on the day of expire only which is in column ‘ad’
If the remark in column ‘ae’ is ‘Expired’ then the mail should be delivered only once and then never in future permanently.

“NOTE: If there is a ‘Closed’ remark in column ‘ae’ then anniversary1-4 and open outlook macro should not be run.”

Finally, I also want to insert other macros in this file which I want to run each time the file is open. So How to add these macros in this workbook code to run automatically after opening the file?

Thanking you in anticipation.

Mukesh

this is what I have for now. I will have to do this little by little in my free time.

But once we finish it you will see how it works. One more thing I will need to add an extra column at the end as a marker that the email was sent the first time the workbook was open. So if todays day is the birrthday send the email and place a 1 at the end so when I close and open again if I see a 1 I will no send. We can hide this later.

This is the code I have so far

Sub Main_Code()

Dim rng As Range
Dim lrow As Long


With Sheeets("Personal")
    lrow = .Cells(Rows.Count, 16).End(xlUp).Row
    For Each rng In .Range("P9:P" & lrow)
        If Day(r.Value) = Day(Date) And _
            Month(r.Value) = Month(Date) And _
            r.Offset(, 7).Value = "Sanctioned" Then
            
            Call Anniversary1
        End If
    Next
End With
        
End Sub

Dear Fredlo2013,
Fine! But for sending mails once daily I have inserted a workbook open event in this workbook code. Which understands that the date is passed and not to send the mail again. So is it necessary of one more column at the end of table to mark 1? Where shall I insert this code in this workbook or in standard module and remove workbook open code from this workbook code?

Please guide me.

Thank you.

Mukesh

the problem will arise when you open the workbook a second time during the same day. How are you going to tell the code that you already sent the mail. Maybe you can think of another way.

Hi,

I have been working on your code now for a while. I am sorry If I modified it too much. Right now the creating part of the emails is clean and ready to lunch. This is how the code looks like

Public Const Msg3 As String = """Hope your Special day"
Public Const Msg4 As String = "Brings you all that"
Public Const Msg5 As String = "Your heart desires"
Public Const Msg6 As String = "Here's wishing you a day"
Public Const Msg7 As String = "Full of pleasant surprises!"
Public Const Msg10 As String = """May God offer you a very Healthy and Wealthy life ahead!!"""
Public Const Msg11 As String = "Please see the attachment."
Public Const Msg12 As String = "With regards,"
Public Const Msg13 As String = "Mukesh Baviskar"


Sub Mail_1A(EmailAddr As String, Name As String)
' Basecode can be found http://msdn.microsoft.com/en-us/library/office/ff458119(v=office.11).aspx
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
' This example sends the last saved version of the Activeworkbook object .
    
    Dim OutApp As Object
    Dim OutMail As Object
    
    'variables for the body and recepients
    
    Dim cell As Range
    Dim Subj As String
    Dim Recipient As String
    Dim Msg1, Msg2, Msg8, Msg9 As String
   
   'add values to the known variables
    Subj = "Happy Birthday"
    Msg1 = "WISH YOU HAPPY BIRTHDAY!"
    Msg2 = "Dear " & Name & ","
    Msg8 = "Happy Birthday"""
    Msg9 = "I have a great pleasure to convey my best wishes on the occasion of your Birth Day!"
    

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
   ' Change the mail address and subject in the macro before you run it.
    With OutMail
        .To = EmailAddr
        .Subject = Subj
        .HTMLBody = "<html>" & "<center><b><i><font face=""Comic Sans MS"" size=""3"" color=""red"">" & Msg1 & _
                    "</font></i></b></center><br/><br/>" & "<center><img src='C:\Cake.jpg'></center><br><br>" & _
                    "<center><b><font face=""Comic Sans MS"" size=""2"" color=""green"">" & _
                    Format(Date, "dd mmmm yyyy") & "</font></b></center><br/><br/>" & _
                    "<font face=""Comic Sans MS"" size=""2"" color=""FF1CAE"">" & Msg2 & _
                    "<center><b><font face=""Comic Sans MS"" size=""2"" color=""blue""><br/><br/>" & _
                    Msg3 & "<br>" & Msg4 & "<br>" & Msg5 & "<br>" & Msg6 & "<br>" & Msg7 & "<br>" & Msg8 & _
                    "</font></b></center><br><br><font color='FF1CAE'>" & Msg9 & "<br><br>" & Msg10 & "<br><br>" & _
                    Msg11 & "<br><br>" & "<font face=""Comic Sans MS"" size=""2"" color=""red"">" & Msg12 & _
                    "<br><br>" & Msg13 & "</font>"
        ' In place of the following statement, you can use ".Display" to
        .Display
        '.Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Sub try()

Call Mail_1A("Al@ya.com", "Afredo")
End Sub

The last small code is just me debugging it and testing.

There note that the code has some arguments that will be passed once its in the conditional code of the Workbook_open.

There is something I don't understand every time you send an email you Fill the cells with Yellow ?

Thanks

PS: I have mail 1 through 4 but I cannot post such a big text here.

Dear Fredlo2010,
First of all I appreciate you for working hard to solve my problem. To avoide any mistake from me I request you to insert the code in my attached file. I have added auxiliary columns to add remarks for mail conditions.

While reading the code I am confused so insert it in the file please.

Thanking you in anticipation.

Mukesh

Hi mukeshbaviskar,

I have been working on your code I have done some housekeeping to make it faster and easier. I am no VBA expert though I just try to help people as I learn. Right now I am facing the issue of sending the email when the workbook opens and only once a day even if its open several times during the day.

Please forum experts and moderators can you give us ideas?

Thanks

Dear Fredlo2010,
No problem! This code takes care of it.

The code is as follows:

Private Sub Workbook_Open()
'run Anniversary macros no more than once per day

Sheets("Personal").Select
With Sheets("Personal").Range("b4")
If .Value < Date Then
.Value = Date
ActiveWorkbook.Save
Else
Exit Sub
End If

End With

Call OpenOutlook
Call Anniversary1
Call Anniversary2
Call Anniversary3
Call Anniversary4

End Sub




I think this will solve our problem definitely.

Thank you.

Mukesh

Hi Fredlo2010,
Does the code work fine? Do share a modified file so that I could think on it to solve our problem positively.

Thanking you in anticipation.

Have a nice day.

Mukesh

Hi Mukesh,

I have been pretty busy. I will finish it tonight I have some ideas that I need to implement.

Thanks

Hi Fredlo2010,
Ok! Don't be hurry. Take your own time to finalize it because in a hurry there may be something wrong.

Thank you for your cooperation.

Mukesh

Hi mukeshbaviskar

I finished working on the workseet. Test it with dummy data before including actual data on it and see if it works.

Attachment 263546

Thanks.

I think it would be a good idea to review your workbook for it to be more efficient. right now it the code has to go through several columns to validate data and then run. It would be better to create a simple database workbook with dates and events to run the code only once.

http://www.und.edu/dept/cndtrain/Excel/database.pdf

Dear Fredlo2013,
Thank you. It's working fine for first and second macro but giving error 13 time mismatch for anniversary3. Please explain me what is in the hidden column 'af'.
You have entered the anniversary code in this workbook module and there are also anniversary macros 1-4 in standard modules. I want to know that which macros are running? Standard modules or this workbook modules.

Thanking you in anticipation.

Mukesh

Hi mukeshbaviskar,

I have attached a new file see if the error went away there was an error in the code I was telling it to use the same template all the time. The code running are the ones under the module Named "Emails" I left your modules untouched so in case something needs to be revised. and the code under ThisWorkbook event is running as well.

The last hidden column has to functions

1. Make sure the email are sent only once a day
2. flag the line for a deceased person so the condolences email are sent only once and never again.

Attachment 263655
I did as much as I could man I am not a vba Expert I am barely learning. Tell me if the code takes long to run or if the workbook takes long to open. The code has to go through different columns with long loops.

Can one of the VBA experts in this forum lend us a hand here guys?

Thanks

Hello Fredlo2013,
Sorry! but the same error is repeating. First 2 macros run very well.

Thank you.

Mukesh

Hi,

On top of each "if" section type "On error resume next" so it look like this section I made for mail 4. Whats happening is that the code is going through the cells looking for dates and all of the sudden it finds "-" and it doesn't know what to do and thus gives you an error. With this small fix we are saying if there is any strange data that cannot be translated into dates then continue next.

Thanks

'chech if Mail_4 has to go out
With Sheets("Personal")
    lrow = .Cells(Rows.Count, 29).End(xlUp).Row
    For Each rng In .Range("AD9:AD" & lrow)
        On Error Resume Next
        If Day(rng) = Day(Date) And Month(rng) = Month(Date) And _
                rng.Offset(0, 1).Value = "Expired" And _
                rng.Offset(0, 2).Value <> 1 Then
            
            'set the Name and recepient variables
            Name = rng.Offset(0, -1).Value
            Recipient = rng.Offset(0, -17).Value
            
            Call Mail_3A(Recipient, Name)
            'add the mark at the end so we ont send it again
            rng.Offset(, 2).Value = 1
            
            'fill in the cell with Yellow
            rng.Offset(, -2).Interior.ColorIndex = 6
         End If
    Next
End With

Hi Fredlo2010,
Thank you. Now the error has gone but only first 2 macros are running and third and fourth macros are not running. Please look into this problem.

Thank you.

Mukesh