Link to home
Create AccountLog in
Avatar of HogRing
HogRing

asked on

Forward email attachment via Outlook 2010 vba macro and template with userform instead of inputbox

I have the following Outlook vba macro that works good, but I want to make it better.  I select an email with attachment in my inbox and activate the macro.  The macro prompts the user for input like First Name, then another prompt for Last Name, then another prompt for Statement Date, etc., etc.  It then calls an Outlook template and replaces text within the html body and subject of the template with the values entered at the inputbox prompts.  It also adds the attachment from the original email (in my case a pdf) along with some static text in the template.  

The down side is that the user gets several input boxes one after the other which is kind of clunky.  Also, if they accidentally triggered the macro they have to keep clicking OK on one input box after another to kill the macro instead of just being able to click cancel once to stop the prompts.

Is it possible to use a userform so that the end user just gets one prompt asking them to enter all the variables in one pop up where they could fill in all the fields and click okay just once or if appropriate click a cancel button to stop the macro from running any further?      

Here is the macro as it exist:

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
Avatar of Qlemo
Qlemo
Flag of Germany image

It is not difficult to create and use a form in Outlook for that. It is difficult to deploy it to other Outlook clients, though. Unless we use the Windows.Forms library to dynamically create the form, which is kind of tedious ...
Avatar of HogRing
HogRing

ASKER

I only have a couple users to deploy it to so I can do it manually.  I don't know if  it's possible to use a form though or how to modify my macro to use it.
ASKER CERTIFIED SOLUTION
Avatar of Nick67
Nick67
Flag of Canada image

Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account
Attached is a form
StatementForm.frm
that I exported from Outlook
StatementForm.frx was created at the same time
I've attached both.

This is the code that will open the form once you import it
Public Sub OpenTheForm()
StatementForm.Show
End Sub

Open in new window


This is the code behind the form
Option Explicit
Private Sub cmdSend_Click()
Dim myItem As Outlook.MailItem
Dim myToBeForwarded As Outlook.MailItem
Dim strRecipient As String
Dim strLastName As String
Dim strFirstName As String
Dim strPrefix As String
Dim strMatterID 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 = Me.txtLastName
strFirstName = Me.txtFirstName
strPrefix = Me.txtSalutation
strMatterID = Me.txtMatterNo
strStatementMonth = Me.txtStatementMonth
strThroughDate = Me.txtThroughDate



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
 
StatementForm.Hide
myItem.Display

End Sub

Open in new window


I think that should do it.
I didn't put any kind of error handling in
(check for dates, blank strings, valid data or anything else)
StatementForm.frm
StatementForm.frx
Avatar of HogRing

ASKER

Thanks Nick67.  I ended up using your "exit sub" suggestion but I'm going to keep the form data and see if I can get that to work for another project.