?
Solved

Forward email including attachment with vba macro that uses an outlook template

Posted on 2014-11-19
4
Medium Priority
?
3,414 Views
Last Modified: 2014-11-21
I have no vba experience but was able to piece together the vba macro below via articles I found on the web, it does most of what I want.  It creates a new email, prompts the user, places the input received into the body of the outlook 2010 template.  The situation is that the user receives a scanned pdf in their Outlook 2010 inbox.  As it is they have to run the macro, answer the prompts and then drag and drop the pdf from the email received from the scanner into the email created by the macro/template.  I want them to be able to use the macro / template to forward the email with the pdf rather than having to create a new email and drag the pdf into it.  

Can I change the macro below so it uses the outlook template to forward an existing email (including it's attachment)?

Sub Statement_Email()
Dim myItem As Outlook.MailItem
Dim strRecipient As String
Dim strStatementMonth As String
Dim strThroughDate As String
Dim strHTML As String


Set myItem = Application.CreateItemFromTemplate("C:\Users\username\AppData\Roaming\Microsoft\Templates\Statement.oft")
strHTML = myItem.HTMLBody

strLastName = InputBox("Recipients Last Name?")
strFirstName = InputBox("Recipients First Name?")
strPrefix = InputBox("Recipients Prefix (ex. Mr., Ms., Dr.)?")
strMatterID = InputBox("Matter Number?")
strStatementMonth = InputBox("What is the statement date?")
strThroughDate = InputBox("Services rendered through what date?")

myItem.HTMLBody = Replace(myItem.HTMLBody, "%STATEMENTMONTH%", strStatementMonth)
myItem.HTMLBody = Replace(myItem.HTMLBody, "%THROUGHDATE%", strThroughDate)
myItem.HTMLBody = Replace(myItem.HTMLBody, "%RECIPIENT%", strRecipient)
myItem.HTMLBody = Replace(myItem.HTMLBody, "%PREFIX%", strPrefix)
myItem.HTMLBody = Replace(myItem.HTMLBody, "%LASTNAME%", strLastName)
myItem.Subject = Replace(myItem.Subject, "%LASTNAME%", strLastName)
myItem.Subject = Replace(myItem.Subject, "%FIRSTNAME%", strFirstName)
myItem.Subject = Replace(myItem.Subject, "%MATTERID%", strMatterID)
myItem.Display

End Sub
0
Comment
Question by:HogRing
[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
  • 2
  • 2
4 Comments
 
LVL 26

Expert Comment

by:Nick67
ID: 40455990
This forwards the actively selected item.
Modify as needed

Public Sub ForwardActiveItem()

Dim Inbox As MAPIFolder
Dim MyItems As Items
Dim MyItem As MailItem

Set Inbox = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set MyItems = Inbox.Items
Set MyItem = Application.ActiveExplorer.Selection(1)
Set MyItem = MyItem.Forward


MyItem.Recipients.Add "someone@somwhere.com"
MyItem.Send

End Sub

Open in new window

0
 
LVL 26

Accepted Solution

by:
Nick67 earned 2000 total points
ID: 40456128
This is fun too.
It will take your existing code and extend it.
It will take all attachments from the actively selected item and put them on your new, template messages

Sub Statement_Email()
Dim myItem As Outlook.MailItem
Dim myToBeForwarded As Outlook.MailItem
Dim strRecipient As String
Dim strStatementMonth As String
Dim strThroughDate As String
Dim strHTML As String

Dim fs As Object
Dim Atmt As Attachment
Dim FileName As String

Dim Inbox As MAPIFolder
Dim MyItems As Items
Dim objOutlookAttach As Outlook.Attachment

Set Inbox = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set MyItems = Inbox.Items
Set myToBeForwarded = Application.ActiveExplorer.Selection(1)
Set fs = CreateObject("Scripting.FileSystemObject")

Set myItem = Application.CreateItemFromTemplate("C:\Users\username\AppData\Roaming\Microsoft\Templates\Statement.oft")
strHTML = myItem.HTMLBody

strLastName = InputBox("Recipients Last Name?")
strFirstName = InputBox("Recipients First Name?")
strPrefix = InputBox("Recipients Prefix (ex. Mr., Ms., Dr.)?")
strMatterID = InputBox("Matter Number?")
strStatementMonth = InputBox("What is the statement date?")
strThroughDate = InputBox("Services rendered through what date?")

myItem.HTMLBody = Replace(myItem.HTMLBody, "%STATEMENTMONTH%", strStatementMonth)
myItem.HTMLBody = Replace(myItem.HTMLBody, "%THROUGHDATE%", strThroughDate)
myItem.HTMLBody = Replace(myItem.HTMLBody, "%RECIPIENT%", strRecipient)
myItem.HTMLBody = Replace(myItem.HTMLBody, "%PREFIX%", strPrefix)
myItem.HTMLBody = Replace(myItem.HTMLBody, "%LASTNAME%", strLastName)
myItem.Subject = Replace(myItem.Subject, "%LASTNAME%", strLastName)
myItem.Subject = Replace(myItem.Subject, "%FIRSTNAME%", strFirstName)
myItem.Subject = Replace(myItem.Subject, "%MATTERID%", strMatterID)
 
For Each Atmt In myToBeForwarded.Attachments
    'save it in C:\temp
    FileName = "C:\TempPDF\" & Atmt.FileName
    Atmt.SaveAsFile FileName
    'now attach it to the new message
    Set objOutlookAttach = myItem.Attachments.Add(FileName)
    fs.deletefile FileName, True
Next
 
myItem.Display

End Sub

Open in new window

0
 

Author Comment

by:HogRing
ID: 40457792
Doesn't look like I correctly posted my closing comment.  Thanks Nick67 your second suggestion worked exactly as I wanted it.
0
 

Author Comment

by:HogRing
ID: 40457811
I posted a separate question trying to find out if I can modify the above macro to use a form instead of inpuboxes if you have any thoughts.  I'm not sure how to add a link but the subject is: "Forward email attachment via Outlook 2010 vba macro and template with userform instead of inputbox"
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

This article will help to fix the below error for MS Exchange server 2010 I. Out Of office not working II. Certificate error "name on the security certificate is invalid or does not match the name of the site" III. Make Internal URLs and External…
If you troubleshoot Outlook for clients, you may want to know a bit more about the OST file before doing your next job. IMAP can cause a lot of drama if removed in the accounts without backing up.
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…
There are cases when e.g. an IT administrator wants to have full access and view into selected mailboxes on Exchange server, directly from his own email account in Outlook or Outlook Web Access. This proves useful when for example administrator want…
Suggested Courses

752 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