Solved

Send another email - additional function requested to a previous solution

Posted on 2013-11-21
13
287 Views
Last Modified: 2013-12-06
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!
0
Comment
Question by:JaseSt
  • 7
  • 6
13 Comments
 
LVL 29

Expert Comment

by:gowflow
ID: 39668401
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
 

Author Comment

by:JaseSt
ID: 39668889
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
 
LVL 29

Accepted Solution

by:
gowflow earned 500 total points
ID: 39670617
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
Free learning courses: Active Directory Deep Dive

Get a firm grasp on your IT environment when you learn Active Directory best practices with Veeam! Watch all, or choose any amount, of this three-part webinar series to improve your skills. From the basics to virtualization and backup, we got you covered.

 

Author Comment

by:JaseSt
ID: 39674752
gowflow, I have implemented this code and will test it shortly. Thank you!
0
 
LVL 29

Expert Comment

by:gowflow
ID: 39675050
ok
0
 

Author Closing Comment

by:JaseSt
ID: 39677388
Excellent! Works perfectly, gowflow. Thank you very much.
0
 
LVL 29

Expert Comment

by:gowflow
ID: 39677461
Excellent and welcome.
gowflow
0
 

Author Comment

by:JaseSt
ID: 39689753
Hi Gowflow,

I have another question if you are interested and available.
0
 
LVL 29

Expert Comment

by:gowflow
ID: 39693662
yes pls go ahead was taken by other issues.
gowflow
0
 

Author Comment

by:JaseSt
ID: 39693673
0
 

Author Comment

by:JaseSt
ID: 39700966
hi gowflow, any chance to work on the latest I posted above?
0
 
LVL 29

Expert Comment

by:gowflow
ID: 39702355
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
 

Author Comment

by:JaseSt
ID: 39702725
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

Featured Post

Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Large Outlook files lead to various unwanted errors and corruption issues. Furthermore, large outlook files can also make Outlook take longer to start-up, search, navigate, and shut-down. So, In this article, i will discuss a method to make your Out…
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …

830 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question