Send another email - additional function requested to a previous solution

This relates to solution provided here:
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28159451.html

In addition to what this function does already I also need it to do the following:

1. Send another email to: nmai@333333

2. In subject: USD MC card activation request for {Col C Col B)

3. In the body:

Hi Nalleli,

Please activate card number {Col T} for {Col C Col B}

PIC:99553333

Thank you.

Michael
Sovereign Gold Card Support
www.sovereigngoldcard.com



The email address and PIC number I will change in the code once received.

Thank you!
JaseStAsked:
Who is Participating?
 
gowflowConnect With a Mentor Commented:
ok here it is

1) Make a copy of your latest Applicant Status file and give it a new name.
2) Open VBA and doubleclick on sheet1 and click on bottom left icon to view 1 sub at a time and select Worksheet_change event and delete all the code that is there.
3) select again Worksheet_change event and paste the below code between Worksheet and End Sub

Dim cCell As Range
Dim fName As String

'---> disable all events while in this procedure to prevent from looping
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False

'---> Update Date in Col O,P,Q,R,S when x is inputed.
For Each cCell In Target
    If (Not Intersect(cCell, Columns("O")) Is Nothing Or _
        Not Intersect(cCell, Columns("P")) Is Nothing Or _
        Not Intersect(cCell, Columns("Q")) Is Nothing Or _
        Not Intersect(cCell, Columns("R")) Is Nothing Or _
        Not Intersect(cCell, Columns("S")) Is Nothing) _
        And LCase(cCell.Value) = "x" Then
        cCell = Format(Now, "mm/dd/yyyy")
    End If
Next cCell


'---> Send Email if Cell in Col N has a value and Cell in Col K or Col J has value
If Not Intersect(Target, Columns("N")) Is Nothing Or Not Intersect(Target, Columns("K")) Is Nothing Or Not Intersect(Target, Columns("J")) Is Nothing Then
    
    '---> USD Subfolder - Col K
    If Range("N" & Target.Row) <> "" And _
        Range("K" & Target.Row) <> "" Then
        If MsgBox("Reply Mail for " & Cells(Target.Row, "C") & ", " & Cells(Target.Row, "B") & " as USD amount entered ?", vbQuestion + vbYesNo, "Send Email") = vbYes Then
            fName = CreateNewCardLoad(Range(Cells(Target.Row, "A"), Cells(Target.Row, "T")))
            SendEmail Range(Cells(Target.Row, "A"), Cells(Target.Row, "T")), Cells(Target.Row, "O"), fName
            Exit Sub
        End If
    End If
    
    '---> EUR Subfolder - Col J
    If Range("N" & Target.Row) <> "" And _
        Range("J" & Target.Row) <> "" Then
        If MsgBox("Reply Mail sending Card Load for " & Cells(Target.Row, "C") & ", " & Cells(Target.Row, "B") & " as EURO amount entered ?", vbQuestion + vbYesNo, "Send Email") = vbYes Then
            fName = CreateNewCardLoad(Range(Cells(Target.Row, "A"), Cells(Target.Row, "T")))
            SendEmail Range(Cells(Target.Row, "A"), Cells(Target.Row, "T")), Cells(Target.Row, "O"), fName
            Exit Sub
        Else
            If MsgBox("Send Mail withought Card Load for " & Cells(Target.Row, "C") & ", " & Cells(Target.Row, "B") & " as EURO amount entered ?", vbQuestion + vbYesNo, "Send Email") = vbYes Then
                SendEmailEURO Range(Cells(Target.Row, "A"), Cells(Target.Row, "T")), Cells(Target.Row, "O")
                Exit Sub
            End If
        End If
    End If


Else
    
    If Not Intersect(Target, Columns("Q")) Is Nothing And InStr(1, Cells(Target.Row, "T"), "5116") <> 0 And Range("Q" & Target.Row) <> "" Then
        Range("W" & Target.Row).NumberFormat = "@"
        Cells(Target.Row, "W") = GetProxy(Cells(Target.Row, "T"))
        If Cells(Target.Row, "W") <> "" Then
            SendActivationEmail Range(Cells(Target.Row, "A"), Cells(Target.Row, "T"))
            SendActivationEmailOther Range(Cells(Target.Row, "A"), Cells(Target.Row, "T"))
        End If
    Else
        If Not Intersect(Target, Columns("Q")) Is Nothing And InStr(1, Cells(Target.Row, "T"), "5116") = 0 And Cells(Target.Row, "T") <> "Not Yet Assigned" And Range("Q" & Target.Row) <> "" Then
            MsgBox ("It seems that the credit card number entered " & Cells(Target.Row, "T") & " does not start with '5116' ")
        End If
    End If
    
End If

'---> Re-activate all events prior exit
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True

Open in new window



4) SAVE the workbook
5) doubleclick on module1 and paste the below new Sub after any end sub

Sub SendActivationEmailOther(Rng As Range)
Dim SendTo As String
Dim sTo
Dim OutlookApp As Object
Dim MItem As Object
Dim subject_ As String
Dim attach_ As String
Dim omail As Outlook.MailItem


'---> Create Outlook
Set OutlookApp = CreateObject("Outlook.Application")

'---> Fill in Subject Details'
subject_ = "USD MC card activation request for (" & Rng.Cells(1, "C") & " " & Rng.Cells(1, "B") & ")"

'---> Fill in email addresses
SendTo = "nmai@333333"

'For I = 0 To UBound(sTo)
'    If SendTo <> "" Then SendTo = SendTo & "; "
'    SendTo = SendTo & LTrim(RTrim(sTo(I)))
'Next I


'---> Create the Email
Set MItem = OutlookApp.CreateItem(0)
With MItem
  .To = SendTo
  .Subject = subject_
  
  .Body = "Hi Nalleli," & Chr(10) & Chr(10) _
    & "Please activate card number (" & Rng.Cells(1, "T") & ") for (" & Rng.Cells(1, "C") & " " & Rng.Cells(1, "B") & ")" & Chr(10) & Chr(10) _
    & "PIC:99553333" & Chr(10) & Chr(10) _
    & "Thank you." & Chr(10) & Chr(10) _
    & "Michael" & Chr(10) _
    & "Sovereign Gold Card Support Services" & Chr(10) _
    & "www.sovereigngoldcard.com"
  'Send the Email
  .Display
End With

'Clear Resources
Set MItem = Nothing
Set OutlookApp = Nothing

End Sub

Open in new window


5) SAVE and Exit the workbook.
6) Open it and give it a try with an item that already have a cc with 5116 by putting an x in Col Q

Let me know.
gowflow
0
 
gowflowCommented:
You have so many send email that I need to know this one is related to what situation ? when what cells is modified and what is already sent ?? which need to be added the above ?
gowflow
0
 
JaseStAuthor Commented:
ok, here it goes. Let me know if this is clear.

Just as the above referenced previous solution performs:

WHEN a card number  beginning with 5116 is inserted in Col T of Applicant Status AND when I insert a value into Col Q (Approved - note: its value turns to a date when I put an x in that column) do the following:

1. Send another email this time to: nmai@333333

2. In subject:
USD MC card activation request for {Col C Col B)

3. In the body:

Hi Nalleli,

Please activate card number {Col T} for {Col C Col B}

PIC:99553333

Thank you.

Michael
Sovereign Gold Card Support
www.sovereigngoldcard.com
0
Cloud Class® Course: CompTIA Cloud+

The CompTIA Cloud+ Basic training course will teach you about cloud concepts and models, data storage, networking, and network infrastructure.

 
JaseStAuthor Commented:
gowflow, I have implemented this code and will test it shortly. Thank you!
0
 
gowflowCommented:
ok
0
 
JaseStAuthor Commented:
Excellent! Works perfectly, gowflow. Thank you very much.
0
 
gowflowCommented:
Excellent and welcome.
gowflow
0
 
JaseStAuthor Commented:
Hi Gowflow,

I have another question if you are interested and available.
0
 
gowflowCommented:
yes pls go ahead was taken by other issues.
gowflow
0
 
JaseStAuthor Commented:
0
 
JaseStAuthor Commented:
hi gowflow, any chance to work on the latest I posted above?
0
 
gowflowCommented:
why don't you answer them and see where it takes you ? there is not only gowflow on the ground !!! you need to appreciate the free ride you have been having for so long !!!
gowflow
0
 
JaseStAuthor Commented:
Well, I would go with them gowflow, but it would mean starting from scratch with them and since you said to "pls go ahead" I took that as meaning you're available and willing. If not, then I'm sorry to have burdened you.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.