Button in New Mail to open a UserForm and transfer info to bottom of email

[Kulguy915]

I have a very small knowledge of VBA so please bare with me.

I need to create a button that shows up whenever I am going to 1) write a new email 2) reply 3)forward.

When that button is clicked, it will open up a UserForm with text Fields that need to be completed. Once all the fields have been completed there will be a "OK" button on the UserForm that when clicked it will transfer the information to the bottom of the email. However, I also need predefined text (like a template) to be inserted along with the text from the UserForm. For Example the predefined text would be:

File ID:
Cutomer #:
etc...

The answers from the text fields would then be inserted next to the above text.
Any further questions please don't hesitate to ask.
Thanks in advance!

[gmayor]

As this is unlikely to be used in every message you create, you should add a button to the Message ribbon to call the following macro when you have a message open for editing. This will call a userform - here UserFormName - and write the data from that form to the open message immediately before the signature block (or if there is no default signature, to the start of the message). You can change the names of the userform and the controls as required. I have coded only two text boxes, but you can add as many as you require and modify the strText text string as appropriate.



Option Explicit
'Graham Mayor - https://www.gmayor.com - Last updated - 28 Sep 2019
Sub Add_Client_ID()
Dim wdDoc As Object
Dim oRng As Object
Dim oBM As Object
Dim oFrm As UserFormName
Dim strText As String
On Error GoTo Err_Handler
If TypeName(ActiveWindow) = "Inspector" Then
If ActiveInspector.IsWordMail And ActiveInspector.EditorType = olEditorWord Then
Set wdDoc = ActiveInspector.WordEditor
On Error Resume Next
Set oBM = wdDoc.bookmarks("_MailAutoSig")
If Not oBM Is Nothing Then
Set oRng = oBM.Range
oRng.Start = oRng.Start - 1
oRng.collapse 1
Else
Set oRng = wdDoc.Range
oRng.collapse 1
End If
On Error GoTo Err_Handler
Set oFrm = New UserFormName
With oFrm
.Show
If .Tag = 0 Then GoTo lbl_Exit
strText = vbCr & "File ID: " & .TextBox1.Text & vbCr & _
"Customer #: " & .TextBox2.Text & vbCr & _
"etc"
Unload oFrm
End With
oRng.Text = strText
oRng.Start = wdDoc.Range.Start
oRng.collapse 1
oRng.Select
Else
GoTo Err_Handler
End If
Else
GoTo Err_Handler
End If
lbl_Exit:
Set wdDoc = Nothing
Set oRng = Nothing
Set oBM = Nothing
Set oFrm = Nothing
Exit Sub
Err_Handler:
Beep
Resume lbl_Exit
End Sub


The userform can have as many text boxes as you need and two buttons. The code for the userform would be as follows. Change the button names as appropriate. The first is obviously the OK button, the other the cancel button. All the text boxes are validated for content.


Option Explicit


Private Sub CommandButton1_Click()
Dim oCtrl As Control
For Each oCtrl In Controls
If TypeName(oCtrl) = "TextBox" Then
If oCtrl.Text = "" Then
MsgBox "Complete TextBox"
Beep
oCtrl.SetFocus
Exit Sub
End If
End If
Next oCtrl
Tag = 1
Hide
End Sub


Private Sub CommandButton2_Click()
Tag = 0
Hide
End Sub

https://www.gmayor.com/Userform.htm

[Kulguy915]

Your codes worked like a charm. Had to do some googling as to where exactly these codes go. Also managed to add some combo boxes to it as well. I don't have any formal training in VBA so the little that I've learned has been through googling and sites like this. I've saved codes that I've used before and take bits and pieces from each one for when I need something done. That being said below is my final code.

Option Explicit
'Graham Mayor - https://www.gmayor.com - Last updated - 28 Sep 2019
Sub Add_Client_ID()
Dim wdDoc As Object
Dim oRng As Object
Dim oBM As Object
Dim oFrm As UserForm1
Dim strText As String
On Error GoTo Err_Handler
If TypeName(ActiveWindow) = "Inspector" Then
If ActiveInspector.IsWordMail And ActiveInspector.EditorType = olEditorWord Then
Set wdDoc = ActiveInspector.WordEditor
On Error Resume Next
Set oBM = wdDoc.bookmarks("_MailAutoSig")
If Not oBM Is Nothing Then
Set oRng = oBM.Range
oRng.Start = oRng.Start + 2
oRng.collapse 1
Else
Set oRng = wdDoc.Range
oRng.collapse 1
End If
On Error GoTo Err_Handler
Set oFrm = New UserForm1
With oFrm
.Show
If .Tag = 0 Then GoTo lbl_Exit
strText = vbCr & "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~" & " " & vbCr & _
"----------------------------------------------------------------------------------------------------" & " " & vbCr & _
"The following information is for HIA/GK internal use and can be ignored." & " " & vbCr & _
"File ID:_ " & .TextBox1.Text & vbCr & _
"Type_PL:_ " & .ComboBox1.Text & vbCr & _
"Type_CL:_ " & .ComboBox2.Text & vbCr & _
"Drawer:_ " & .ComboBox3.Text & vbCr & _
"POL:_ " & .TextBox2.Text & vbCr & _
"----------------------------------------------------------------------------------------------------"
Unload oFrm
End With
oRng.Text = strText
oRng.Start = wdDoc.Range.Start
oRng.collapse 1
oRng.Select
Else
GoTo Err_Handler
End If
Else
GoTo Err_Handler
End If
lbl_Exit:
Set wdDoc = Nothing
Set oRng = Nothing
Set oBM = Nothing
Set oFrm = Nothing
Exit Sub
Err_Handler:
Beep
Resume lbl_Exit
End Sub

Feel free to give me any pointers on how I could have done things differently and more efficiently.

[Kulguy915]

I also just need help on one more thing. When I click the button on the ribbon to pop up the User Form, the form gets placed on various places of my 3 screens. I do have a code from another project (on Excel) I was working on that would center the User Form over the excel sheet that i was using. But since this code was being used on Excel I had put the code on the "Sheet1". And since I'm now trying to do this on Outlook, well, obviously there isn't a sheet so I'm a bit stuck.

Private Sub CommandButton1_Click()

With UserForm1
.StartUpPosition = 0
.Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
.Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
.Show
End With
End Sub

Any help would be much appreciated!