?
Solved

Excel 2010 to Outlook Function

Posted on 2013-10-22
9
Medium Priority
?
270 Views
Last Modified: 2013-11-05
This is a needed edit to the solution provided on question:
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28156647.html

Currently in the Applicant Status sheet when a value 'x' is input into Col N AND there is a value in Col K an email is initiated. That works great but I need it altered a bit so that:

1. When there is NO value in Col O it sends as you have it in the body of the email. Keep it as is.

2. However, when there IS a value of "reseller" in Col O change the text in the body of the email from: "Please have his card shipped to address indicated on spreadsheet." to "No need to have card shipped."

3. And, when a value is in Col O (and it is usually a string containing name, address and city, state and country and postal code data):

Change the body in the email from: "Please have his card shipped to address indicated on spreadsheet." to: "Please have the card shipped to: {whatever the string data is in Col O}"
0
Comment
Question by:JaseSt
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 4
9 Comments
 
LVL 31

Accepted Solution

by:
gowflow earned 2000 total points
ID: 39590969
ok here it is:

1) Make a copy of your latest Applicant Status file and give it a new name.
2) Open it and goto vba and doubleclick on Sheet1 and select the worksheet_change event
3) click on the bottom left icon to view 1 sub at a time.
4) Delete all the code that is between
Sub Worksheet_change
...
End Sub
5) Keep on the Sub and End Sub and paste in between the below code.

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 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
        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"))
        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


6) SAVE the workbook
7) doubleclick on module1
8) Click on the bottom left icon to view 1 sub at a time.
9) Select the Sub SendEmail and delete all the code that is there.
10) Paste the below code after any end sub

Sub SendEmail(Rng As Range, sAddress As String, Optional fName As String)
Dim WB As Workbook
Dim WS As Worksheet


Dim SendTo As String
Dim Blindcc As String
Dim OutlookApp As Object
Dim MItem As Object
Dim subject_ As String
Dim attach_ As String
Dim fFile
Dim omail As Outlook.MailItem
Dim sShipto As String

Application.DisplayAlerts = False

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

'Fill in Subject Details'
subject_ = "New Mastercard Application for (" & Rng.Cells(1, "B") & " " & Rng.Cells(1, "C") & ")"
SendTo = "nmai@banking.bz"
Blindcc = "david@offshorelawcenter.com"

'Create the Email
Set MItem = OutlookApp.CreateItem(0)
With MItem
  .To = SendTo
  .BCC = Blindcc
  .Subject = subject_
  
  '---> Attach files
  For Each fFile In Rng.SpecialCells(xlCellTypeFormulas)
        If InStr(1, fFile.Formula, "HYPERLINK") <> 0 Then
            fpos = InStr(1, fFile.Formula, "HYPERLINK") + 11
            attach_ = Mid(fFile.Formula, fpos, InStr(fpos, fFile.Formula, Chr(34)) - fpos)
            .Attachments.Add (attach_)
        End If
  Next fFile
  
  '---> Only Attach file when fName is linked ie Col K
  If fName <> "" Then
    .Attachments.Add (fName)
  End If
  
  '---> Determin shipto
  Select Case UCase(sAddress)
    Case "" 'sAddress empty then do as before
        sShipto = "Please have his card shipped to address indicated on spreadsheet."
    
    Case "RESELLER"
        sShipto = "No need to have card shipped."
    
    Case Else
        sShipto = sAddress
        
  End Select
  
  .Body = "Hi Nalleli," & Chr(10) & Chr(10) _
    & "Attached are the documents and load request for (" & Rng.Cells(1, "B") & " " & Rng.Cells(1, "C") & ")" & Chr(10) _
    & sShipto & Chr(10) _
    & "PIC:99554Freedom" & Chr(10) & Chr(10) _
    & "Please let me know you received this email." & Chr(10) & Chr(10) _
    & "Thank you." & Chr(10) & Chr(10) _
    & "Michael" & Chr(10) _
    & "Sovereign Gold Card Support" & Chr(10) _
    & "www.sovereigngoldcard.com"

  'Send the Email
  .Display
End With

'Clear Resources
Set MItem = Nothing
Set OutlookApp = Nothing

Application.DisplayAlerts = True
End Sub

Open in new window


11) SAVE the workbook and Exit
12) open it and give it a try in the different scenarios as well as other functions to make sure all is ok.

gowflow
0
 

Author Comment

by:JaseSt
ID: 39595612
Thanks gowflow. I'll get to installing and testing this later tonight. Thanks again.
0
 

Author Comment

by:JaseSt
ID: 39600050
gowflow. Works perfectly however the wording for sending to a specific address is not complete (when there is data in Col O). It says:

Attached are the documents and load request for (John Smith)
John's Club,
9 SW 565th St.
Fort Lauderdale, Florida 33315  USA

It needs to say:
Attached are the documents and load request for (John Smith)
Please have card shipped to the below address:
John's Club,
9 SW 565th St.
Fort Lauderdale, Florida 33315  USA

I can insert the string: "Please have card shipped to the below address:" in the code if you want. Just tell me where

Thank you!
0
Veeam Disaster Recovery in Microsoft Azure

Veeam PN for Microsoft Azure is a FREE solution designed to simplify and automate the setup of a DR site in Microsoft Azure using lightweight software-defined networking. It reduces the complexity of VPN deployments and is designed for businesses of ALL sizes.

 
LVL 31

Assisted Solution

by:gowflow
gowflow earned 2000 total points
ID: 39603366
ok sorry it was not clear in your post.

Here is the change in the Sub SendEmail in VBA module1 under the line Case Else you will need to do following:


change this line
sShipto = sAddress


and replace it  by this line
sShipto = "Please have the card shipped to below address:" & Chr(10) & sAddress


SAVE and Exit the workbook and then load and try it again.
gowflow
0
 

Author Closing Comment

by:JaseSt
ID: 39603429
gowflow rocks again. Great to have you back!
0
 
LVL 31

Expert Comment

by:gowflow
ID: 39603517
Your welcome
gowflow
0
 

Author Comment

by:JaseSt
ID: 39608305
gowflow, I have another question for you if you care to tackle it. I think it's rather easy. Every time my Visa workbook starts (when I open the file) I get the popup message to locate the Totals folder. I would like it to find it itself and stop this pop up.

Let me know and if you want to do it I'll post the link here.
0
 
LVL 31

Expert Comment

by:gowflow
ID: 39620989
Sorry for late reply I was out travelling and just came back and saw your reply.

Pls post in here any link you would need help with.
Rgds/gowflow
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

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

You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
If you need to forecast numbers -- typically for finance -- the Windows and Mac versions of Excel 2016 have a basket of tools to get the job done.
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…
This is my first video review of Microsoft Bookings, I will be doing a part two with a bit more information, but wanted to get this out to you folks.
Suggested Courses

801 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