Solved

Excel 2010 to Outlook Function

Posted on 2013-10-22
9
226 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
  • 5
  • 4
9 Comments
 
LVL 29

Accepted Solution

by:
gowflow earned 500 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
 
LVL 29

Assisted Solution

by:gowflow
gowflow earned 500 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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

Author Closing Comment

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

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 29

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
 

Author Comment

by:JaseSt
ID: 39624085
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Use email signature images to promote corporate certifications and industry awards.
Follow this checklist to learn more about the 15 things you should never include in an email signature from personal quotes, animated gifs and out-of-date marketing content.
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: …

706 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

15 Experts available now in Live!

Get 1:1 Help Now