Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Send another email - additional function requested to a previous solution

Posted on 2013-11-21
13
Medium Priority
?
306 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 31

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 31

Accepted Solution

by:
gowflow earned 2000 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
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 

Author Comment

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

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 31

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 31

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 31

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 Backup Tool for VMware and Hyper-V

Restore full virtual machine or individual guest files from 19 common file systems directly from the backup file. Schedule VM backups with PowerShell scripts. Set desired time, lean back and let the script to notify you via email upon completion.  

Question has a verified solution.

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

With so many activities to perform, Exchange administrators are always busy in organizations. If everything, including Exchange Servers, Outlook clients, and Office 365 accounts work without any issues, they can sit and relax. But unfortunately, it…
Mailbox Corruption is a nightmare every Exchange DBA wishes he never has. Recovering from it can be super-hectic if not entirely futile. And though techniques like the New-MailboxRepairRequest cmdlet have been designed to help with fixing minor corr…
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.
There are cases when e.g. an IT administrator wants to have full access and view into selected mailboxes on Exchange server, directly from his own email account in Outlook or Outlook Web Access. This proves useful when for example administrator want…

782 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