Solved

How do I make a button that opens a prepopulated Outlook email message?

Posted on 2014-12-05
8
369 Views
Last Modified: 2014-12-05
I need a button on a standard worksheet I use that opens up an new email message with the recipient, subject line and body of the message prepopulated.

The subject line I need is-
Loan Inquiry Packet, Cust Code: (code pulled from cell S3 in the same sheet the button is on; name of the sheet is NEW Inquiry)

In the body of the message, I need-

Cust Name:
Attn:
Address1:
Address2:
City:
State:
Zip:

A hardcopy letter has been placed in your physical inbox, to be included with the packet.

Additional Comments:
0
Comment
Question by:K_Deutsch
8 Comments
 
LVL 7

Expert Comment

by:Katie Pierce
ID: 40483289
If you right click the cell you want to use as the launching point, select "Hyperlink", then "E-mail Address" in the left menu.  You can enter the email address and the subject line, as well as how the link appears in the spreadsheet.  However, there is no way to enter the content of the body of the email, sadly.
0
 
LVL 26

Expert Comment

by:Nick67
ID: 40483422
" However, there is no way to enter the content of the body of the email, sadly. "

Of course there's a way, don't be silly, but it is considerably more complex.
You have to code it.
Open Outlook
Create a message
Add the fields and properties

Like attached
Mail.xls
0
 
LVL 5

Expert Comment

by:Hakan Yılmaz
ID: 40483687
You can use vba code.
If you make a list of individual mail items to send, you can make it automatically fill up the template and send mails to recipients in order.

Sub PopulateMail()
    Dim SheetName As String
    Dim OutApp As Object
    Dim OutMail As Object
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    SheetName = "NEW Inquiry"

    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "Loan Inquiry Packet, Cust Code: " & ThisWorkbook.Worksheets(SheetName).Range("S3").Value
        .Body =  "Cust Name:" & vbNewLine & "Attn:" & vbNewLine & _
                 "Address1:" & vbNewLine & "Address2:" & vbNewLine & _
                 "City:" & vbNewLine & "State:" & vbNewLine & "Zip:" & vbNewLine & _
                 vbNewLine & "A hardcopy letter has been placed in your physical inbox, to be included with the packet." & vbNewLine & _
                 vbNewLine & "Additional Comments:"
        .Display
    End With
End Sub

Open in new window


I didn't tested the code because i don't have Outlook now.
If it makes body message in single line, you may need to change all "vbNewLine" to "vbCrLf".
0
Free learning courses: Active Directory Deep Dive

Get a firm grasp on your IT environment when you learn Active Directory best practices with Veeam! Watch all, or choose any amount, of this three-part webinar series to improve your skills. From the basics to virtualization and backup, we got you covered.

 

Author Comment

by:K_Deutsch
ID: 40484026
Nick67, I like your solution and it's really close, but the body of the message only contains Additional Comments. I did some more inspecting of the code, and it seems that ONLY the last line of the .body section shows up in the email. There's nothing different or special about Additional Comments just that it's the last item of its kind in the code.
0
 
LVL 26

Expert Comment

by:Nick67
ID: 40484030
Maybe I screwed up.
...
I did, I did screw up

   .Body = Sheets(1).Range("E1") & " " & Sheets(1).Range("E2") & vbCrLf
    .Body = Sheets(1).Range("F1") & " " & Sheets(1).Range("F2") & vbCrLf
    .Body = Sheets(1).Range("G1") & " " & Sheets(1).Range("G2") & vbCrLf
    .Body = Sheets(1).Range("H1") & " " & Sheets(1).Range("H2") & vbCrLf
    .Body = Sheets(1).Range("I1") & " " & Sheets(1).Range("I2") & vbCrLf
    .Body = Sheets(1).Range("J1") & " " & Sheets(1).Range("J2") & vbCrLf
    .Body = Sheets(1).Range("K1") & " " & Sheets(1).Range("K2") & vbCrLf
    .Body = Sheets(1).Range("L1") & " " & Sheets(1).Range("L2") & vbCrLf
    .Body = Sheets(1).Range("M1") & " " & Sheets(1).Range("M2") & vbCrLf


We'd like to concatenate the body together

   .Body = Sheets(1).Range("E1") & " " & Sheets(1).Range("E2") & vbCrLf
    .Body = .Body & Sheets(1).Range("F1") & " " & Sheets(1).Range("F2") & vbCrLf
    .Body = .Body & Sheets(1).Range("G1") & " " & Sheets(1).Range("G2") & vbCrLf
    .Body = .Body & Sheets(1).Range("H1") & " " & Sheets(1).Range("H2") & vbCrLf
    .Body = .Body & Sheets(1).Range("I1") & " " & Sheets(1).Range("I2") & vbCrLf
    .Body = .Body & Sheets(1).Range("J1") & " " & Sheets(1).Range("J2") & vbCrLf
    .Body = .Body & Sheets(1).Range("K1") & " " & Sheets(1).Range("K2") & vbCrLf
    .Body = .Body & Sheets(1).Range("L1") & " " & Sheets(1).Range("L2") & vbCrLf
    .Body = .Body & Sheets(1).Range("M1") & " " & Sheets(1).Range("M2") & vbCrLf
0
 
LVL 26

Accepted Solution

by:
Nick67 earned 500 total points
ID: 40484046
This one will do it right and suck the data off the row of the active cell
Mail-v2.xls
0
 

Author Closing Comment

by:K_Deutsch
ID: 40484117
Nailed it.
0
 
LVL 26

Expert Comment

by:Nick67
ID: 40484121
Glad you liked it!
Final Code below.
Note the proper way to open Outlook, which only tolerates one instance at a time!

Nick67

Option Explicit
Public wasOpen As Boolean
Function StartApp(ByVal appName) As Object
On Error GoTo ErrorHandler
Dim oApp As Object

wasOpen = True
Set oApp = GetObject(, appName)    'Error here - Run-time error '429':
Set StartApp = oApp

Exit Function

ErrorHandler:
If Err.Number = 429 Then
    'App is not running; open app with CreateObject
    Set oApp = CreateObject(appName)
    wasOpen = False
    Resume Next
Else
    MsgBox Err.Number & " " & Err.Description
End If
End Function


Public Sub CreateAnEmail()
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim objOutlookExplorers As Outlook.Explorers
Dim ns As Outlook.Namespace
Dim Folder As Outlook.MAPIFolder

Set objOutlook = StartApp("Outlook.Application")
Set ns = objOutlook.GetNamespace("MAPI")
Set Folder = ns.GetDefaultFolder(olFolderInbox)
Set objOutlookExplorers = objOutlook.Explorers

If wasOpen = False Then
    objOutlookExplorers.Add Folder
    Folder.Display
    'done opening
End If


' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

With objOutlookMsg

    ' Add the To recipient(s) to the message.
    Set objOutlookRecip = .Recipients.Add(Sheets(1).Cells(ActiveCell.Row, 1))
    objOutlookRecip.Type = olTo
    
    ' Add the CC recipient(s) to the message.
    Set objOutlookRecip = .Recipients.Add(Sheets(1).Cells(ActiveCell.Row, 2))
    objOutlookRecip.Type = olCC
    
    ' Add the BCC recipient(s) to the message.
    Set objOutlookRecip = .Recipients.Add(Sheets(1).Cells(ActiveCell.Row, 3))
    objOutlookRecip.Type = olBCC
    
    'MsgBox ActiveCell.Row
    
    .Subject = Sheets(1).Cells(ActiveCell.Row, 4).Value
    .Body = .Body & Sheets(1).Range("E1") & " " & Sheets(1).Cells(ActiveCell.Row, 5) & vbCrLf
    .Body = .Body & Sheets(1).Range("F1") & " " & Sheets(1).Cells(ActiveCell.Row, 6) & vbCrLf
    .Body = .Body & Sheets(1).Range("G1") & " " & Sheets(1).Cells(ActiveCell.Row, 7) & vbCrLf
    .Body = .Body & Sheets(1).Range("H1") & " " & Sheets(1).Cells(ActiveCell.Row, 7) & vbCrLf
    .Body = .Body & Sheets(1).Range("I1") & " " & Sheets(1).Cells(ActiveCell.Row, 9) & vbCrLf
    .Body = .Body & Sheets(1).Range("J1") & " " & Sheets(1).Cells(ActiveCell.Row, 10) & vbCrLf
    .Body = .Body & Sheets(1).Range("K1") & " " & Sheets(1).Cells(ActiveCell.Row, 11) & vbCrLf
    .Body = .Body & Sheets(1).Range("L1") & " " & Sheets(1).Cells(ActiveCell.Row, 12) & vbCrLf
    .Body = .Body & Sheets(1).Range("M1") & " " & Sheets(1).Cells(ActiveCell.Row, 13) & vbCrLf
    .Display
End With

End Sub

Open in new window

0

Featured Post

NEW Veeam Agent for Microsoft Windows

Backup and recover physical and cloud-based servers and workstations, as well as endpoint devices that belong to remote users. Avoid downtime and data loss quickly and easily for Windows-based physical or public cloud-based workloads!

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
merge/join/combine multiple tables into one master table 2 46
Excel formula that pulls back the id 4 41
Exchange 2007 6 21
Outlook search issues 5 15
Finding original email is quite difficult due to their duplicates. From this article, you will come to know why multiple duplicates of same emails appear and how to delete duplicate emails from Outlook securely and instantly while vital emails remai…
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

749 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