Solved

Send another email - additional function requested to a previous solution

Posted on 2013-11-21
13
261 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
Comment Utility
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
Comment Utility
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
Comment Utility
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
 

Author Comment

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

Expert Comment

by:gowflow
Comment Utility
ok
0
 

Author Closing Comment

by:JaseSt
Comment Utility
Excellent! Works perfectly, gowflow. Thank you very much.
0
Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

 
LVL 29

Expert Comment

by:gowflow
Comment Utility
Excellent and welcome.
gowflow
0
 

Author Comment

by:JaseSt
Comment Utility
Hi Gowflow,

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

Expert Comment

by:gowflow
Comment Utility
yes pls go ahead was taken by other issues.
gowflow
0
 

Author Comment

by:JaseSt
Comment Utility
0
 

Author Comment

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

Expert Comment

by:gowflow
Comment Utility
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
Comment Utility
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

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Granting full access permission allows users to access mailboxes present in their database. By giving full access permission one can open and read the content of any mailbox but cannot send emails from that mailbox.
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

743 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

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now