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

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
HogRingAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Nick67Commented:
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
Nick67Commented:
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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
HogRingAuthor Commented:
Doesn't look like I correctly posted my closing comment.  Thanks Nick67 your second suggestion worked exactly as I wanted it.
1
HogRingAuthor Commented:
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
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.