I want my email template to prompt me for input, and replace specified fields with my input.
For example my email will be like:
Hello [name]
I want a box to pop up where I can enter the name and have it appear throughout the email, replacing [name].
Using my example, by saving "#0#" in your template in the "to:" section of the email, by clicking this template it will prompt you to change that entry with the "Email Address" question.
Sub CommandButton1_Click()
Call OpenTemplate
End Sub
Sub OpenTemplate()
Dim OutMail As Outlook.MailItem
Set OutMail = Application.CreateItemFromTemplate("Template Location")
On Error Resume Next
With OutMail
.To = Replace(.To, "#0#", InputBox("Email Address"))
.CC = ""
.BCC = ""
.Subject = Replace(.Subject, "#1#", InputBox("Prompt 1"))
.Body = Replace(.Body, "#2#", InputBox("Prompt 2"))
.Body = Replace(.Body, "#3#", InputBox("Prompt 3"))
.Body = Replace(.Body, "#4#", InputBox("Prompt 4"))
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Related
I have a simple code to open Microsoft Outlook and send an email with an attachment. I would like to send the email securely. Meaning, I would like to know if there is any code that would be tantamount to pressing the "Send Securely" button in outlook. Here is my code so far.....
Sub EmailInvoice()
Dim OutlookApp As Object, OutlookMessage As Object
Dim FileName As String, EmailAddress As String
EmailAddress = Range("ProviderEmail").Value
FileName = "C:\Users\rblahblahblah.txt"
Set OutlookApp = GetObject(class:="Outlook.Application") 'Handles if
Outlook is already open
Err.Clear
If OutlookApp Is Nothing Then Set OutlookApp =
CreateObject(class:="Outlook.Application") 'If not, open Outlook
If Err.Number = 429 Then
MsgBox "Outlook could not be found, aborting.", 16, "Outlook Not Found"
Exit Sub
End If
'Create a new email message
Set OutlookMessage = OutlookApp.CreateItem(0)
'Create Outlook email with attachment
With OutlookMessage
.To = EmailAddress
.CC = ""
.BCC = ""
.Subject = "Invoice for Upload - " & Month
.Body = "Please upload the attached file to the Vendor Portal."
.Attachments.Add FileName
.Display
.Send
End With
End Sub
The code below will send it with a sensitivity enumeration but not securely (Certified Mail). I also add my signature (Default) to the email.
Sub Mail_workbook_Outlook_1()
'Working in Excel 2000-2013
'This example send the last saved version of the Activeworkbook
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim SigString As String
Dim Signature As String
For Each cell In ThisWorkbook.Sheets("Email List").Range("B1:B100")
If cell.Value Like "?*#?*.?*" And LCase(cell.Offset(0, 1).Value) = "yes" Then
strto = strto & cell.Value & ";"
End If
Next cell
If Len(strto) > 0 Then strto = Left(strto, Len(strto) - 1)
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'Change only Mysig.htm to the name of your signature
SigString = Environ("appdata") & "\Microsoft\Signatures\Default.htm"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
On Error Resume Next
With OutMail
.to = strto
.CC = ""
.BCC = ""
.Subject = ("*Confidential*: Policyholder Name Here - Policy # Here - Premium Bill")
.HTMLBody = "Attached is the most recent premium bill in Excel." & "<br><br>" & Signature
.Attachments.Add ActiveWorkbook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Importance = 2 '(0=Low, 1=Normal, 2=High)
.Sensitivity = 3 '(0=Normal, 1=Personal, 2=Private, 3=Confidential)
.Send 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function
I'm trying to create a template where I can have VBA prompt me to change items in the subject. I've a template email with the subject line that should be Project / GC/Client, and in the template I've written that as #0# / #1#.
I'm at the below, but it's erroring.
Private Sub m_Inspector_Activate()
Dim Item As MailItem
Dim Value As String
If TypeOf m_Inspector.CurrentItem Is MailItem Then
Set mail = m_Inspector.CurrentItem
If mail.Subject = "subject" Then
Value = InputBox("Project")
mail.Subject = Replace(mail.Subject, "#0#", Value)
Value = InputBox("GC/Client")
mail.Subject = Replace(mail.Subject, "#1#", Value)
End If
End If
End Sub
This code is used on a template button in Outlook. i.e. the template file it is launching contains the subject line of #0# / #1#. Ideally, after the template launches, the macro prompts the user to update those two fields with the proper subjects.
Sub CommandButton1_Click()
Set MyItem = Application.CreateItemFromTemplate _
("V:\All Folders\Templates\Freebie.oft")
MyItem.Display
End Sub
If all that you really want to do is open a template and replace text in the subject line, this may work for you:
Sub CommandButton1_Click()
Call OpenTemplate
End Sub
Sub OpenTemplate()
Dim OutMail As Outlook.MailItem
Set OutMail = Application.CreateItemFromTemplate("V:\All Folders\Templates\Freebie.oft")
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = Replace(.Subject, "#0#", InputBox("Project"))
.Subject = Replace(.Subject, "#1#", InputBox("GC/Client"))
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
If we can avoid using the Inspector then this is much simpler
I have the following code which lets me prepare an email which is ready to be sent:
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = ThisWorkbook.Sheets("Users").Range("A1").Value
.CC = ""
.BCC = ""
.Importance = 2
.Subject = "[ACTION REQUIRED] Format(Date, "YYYYMMDD")"
.HTMLBody = "some_body"
.Display
End With
and here is the Users table:
Users Johnson, Jerry Mullen, Carl Mullen, Carl Mullen, Carl Terry, Mark Carlos, Juan
I need to create a macro which lets me prepare an email but my main problem is I don't know how to add recipients using data from Users table.
My current code is not allowing me to attach anything aside from string values (typed directly, or maybe I'm doing something wrong).
I also need it to not attach names that are duplicated.
The following code assumes that you have your users' names in your outlook contact list, and that they are located in the cells A2 and down, but that range can be altered.
Sub test()
Dim users As New Collection
Dim usrRng As Range
Dim recipients As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set usrRng = Range("A2", Range("A2").End(xlDown))
Application.ScreenUpdating = False
On Error Resume Next
For Each cell In usrRng
users.Add cell.Value, cell.Value
Next cell
On Error GoTo 0
For Each usrName In users
recipients = recipients & usrName & "; "
Next usrName
With OutMail
.To = recipients
.CC = ""
.BCC = ""
.Importance = 2
.Subject = "[ACTION REQUIRED] " & Format(Date, "YYYYMMDD")
.HTMLBody = "some_body"
.Display
End With
Application.ScreenUpdating = True
End Sub
What this does, is that it takes each name in the range A2 and down, and adds it to a collection, skipping the duplicates.
Then we make a string, which will be made out of each name we just added to the collection, seperating each name with a ";".
Then we pass that new string to the OutMail object as the receiver of the message.
When the new mail is displayed, the names will not be recognized, but if press send, the mail should be sent to the correct people, assuming you don't have multiple contacts with the same name.
I create a new email with the code below.
I'd like to have an attachment. I think I have to use an OutMail.Attachment.Method but the attachment needs to be a specific email.
I want the entire email with contents (ie. texts, files, pics, etc.) as the attachment.
I'd like to attach whatever email I have highlighted (as an .msg).
Public Sub RemarkRequest()
Dim OutApp As Object
Dim OutMail As Object
Dim Signature As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
'Get the user signature
With OutMail
.Display
End With
Signature = OutMail.HTMLBody
'Change the mail address and subject in the macro before you run it.
With OutMail
.To = "yyy#bbb.com; zzz#bbb.com"
.CC = ""
.BCC = ""
.Subject = "Subject"
.HTMLBody = "Text" & Signature
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Example will be -
'// Forces explicit declaration of all variables in a file
Option Explicit
Sub ForwardAsAttchment()
'// Declare variables
Dim olMsg As Outlook.MailItem
Dim olItem As Outlook.MailItem
Dim olSignature As String
On Error Resume Next
If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox ("No Item selected")
Exit Sub
End If
For Each olItem In Application.ActiveExplorer.Selection
Set olMsg = Application.CreateItem(olMailItem)
'// Get the user signature
With olMsg
.Display
End With
olSignature = olMsg.HTMLBody
'// Change the mail address and subject in the macro before you run it.
With olMsg
.Attachments.Add olItem, olEmbeddeditem ' Attch Selected email
.Subject = "Subject"
.To = "yyy#bbb.com; zzz#bbb.com"
.CC = ""
.BCC = ""
.HTMLBody = "Text" & olSignature
.Display
' .Send
End With
Next
'// Clean up
Set olItem = Nothing
Set olMsg = Nothing
End Sub
I am trying to send an email through vba in excel, all works fine excpect the email attachement. It doesnt seem to link it. Where could be the issue ?
The string attach is pointing to the right file.
Dim OutApp As Object
Dim OutMail As Object
Dim email
Dim attach
email = writeEmailAddress()
attach = attachement()
Sheets("Mail").Range("B1") = email
Sheets("Mail").Range("B2") = "xxxxxx"
Sheets("Mail").Range("B3") = "xxxxxxx"
Sheets("Mail").Range("B4") = attach
MsgBox attach
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.SendKeys "^{ENTER}"
.to = "xxxxx"
.CC = ""
.BCC = ""
.Subject = Sheets("Mail").Range("B5").Value
.Body = Sheets("Mail").Range("B6").Value
'You can add other files also like this
.Attachments.Add attach ' <--------------------------------This is causing troubble
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Change,
.Attachments.Add attach
... to,
If CBool(Len(Dir(attach, vbNormal))) Then
.Attachments.Add attach, 1 '<~~ 1 is olByValue
Else
Debug.Print "Cannot find '" & attach & "'"
End If
If the attachment is not added to your email item, check the VBE's Immediate Window (e.g. Ctrl+G) for the error message.