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").GetDe
Set MyItems = Inbox.Items
Set myToBeForwarded = Application.ActiveExplorer
Set fs = CreateObject("Scripting.Fi
Set myItem = Application.CreateItemFrom
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.Attachment
'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(Fil
fs.deletefile FileName, True
Next
myItem.Display
End Sub
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").GetDe
Set MyItems = Inbox.Items
Set myToBeForwarded = Application.ActiveExplorer
Set fs = CreateObject("Scripting.Fi
Set myItem = Application.CreateItemFrom
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.Attachment
'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(Fil
fs.deletefile FileName, True
Next
myItem.Display
End Sub
Qlemo
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 ...
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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
This is the code behind the form
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
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 SubThis 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 SubI 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
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.