[Last Call] Learn about multicloud storage options and how to improve your company's cloud strategy. Register Now

x
?
Solved

Excel 2010 to Outlook Function

Posted on 2013-10-22
9
Medium Priority
?
273 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
NFR key for Veeam Agent for Linux

Veeam is happy to provide a free NFR license for one year.  It allows for the non‑production use and valid for five workstations and two servers. Veeam Agent for Linux is a simple backup tool for your Linux installations, both on‑premises and in the public cloud.

 
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

Ask an Anonymous Question!

Don't feel intimidated by what you don't know. Ask your question anonymously. It's easy! Learn more and upgrade.

Question has a verified solution.

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

This article describes how to import Lotus Notes Contacts into Outlook 2016, 2013, 2010 and 2007 etc. with a few manual steps. You can easily export and migrate Lotus Notes contacts into Microsoft Outlook without having to use any third party tools.
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.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …

650 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