?
Solved

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

Posted on 2014-11-19
4
Medium Priority
?
3,877 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
  • 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.
1
 

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

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

There can be many situations demanding the conversion of Outlook OST files to PST format and as such, there is no shortage of automated tools to perform this conversion. However, what makes Stellar OST to PST converter stand above the rest? Let us e…
As a Microsoft Exchange user, you must have known the importance of an Offline storage table (OST) file. It is nothing new for an Outlook user to be dependent on a .ost file during a server break down or a problematic Internet connection. In such a…
CodeTwo Sync for iCloud (http://www.codetwo.com/sync-for-icloud?sts=6554) automatically synchronizes your Outlook 2016, 2013, 2010 or 2007 folders with iCloud folders available via iCloud Control Panel. This lets you automatically sync them with…
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

621 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