I have a dynamic search box filtering a subform based on user input. I also have a few filter buttons that filter the same subform. I set up the search box to incorporate preexisting filters applied by those buttons.
All that works fine. The problem I have is:
The dynamic filter using the LIKE statement only seems to work correctly when the length of the filter text is >= 3. Go below that and it applies some wonky filtering. Maybe I am using the statement wrong. I thought it would look if the field's value contains the search string somewhere in it. But it seemingly accepts values like "Natronlauge 50% techn. EN 896" for a search string of "Hä", which seems weird to me. It works once I add a third character though. Lines 11 and 13:
Me.Form.Filter = "[bezeichnung] LIKE '*" & SearchBoxStoffe & "*' AND [kategorie] = '" & Forms![HUB]![FilterAlleLink] & "'"
Would be nice if someone has some ideas how to go about these issues.
Here the full code for my searchbox:
Private Sub SearchBoxStoffe_KeyUp(KeyCode As Integer, Shift As Integer)
On Error GoTo errHandler
Dim filterText As String
'Apply dynamic filter for current filter category.
If Len(SearchBoxStoffe.Text) > 0 Then
filterText = SearchBoxStoffe.Text
If Forms![HUB]![FilterAlleLink] = "" Then
Me.Form.Filter = "[bezeichnung] LIKE '*" & SearchBoxStoffe & "*'"
Else
Me.Form.Filter = "[bezeichnung] LIKE '*" & SearchBoxStoffe & "*' AND [kategorie] = '" & Forms![HUB]![FilterAlleLink] & "'"
End If
Me.FilterOn = True
'Retain filter text in search box after refreshing.
SearchBoxStoffe.Text = filterText
SearchBoxStoffe.SelStart = Len(SearchBoxStoffe.Text)
Else
'Revert to current main filter category.
If Forms![HUB]![FilterAlleLink] <> "" Then
Call FilterStoffe("[kategorie] = '" & Forms![HUB]![FilterAlleLink] & "'")
Else
If Forms![HUB]![FilterAlleLink] = "" Then
Me.Filter = ""
Me.FilterOn = False
End If
End If
End If
'Set focus back to search box
SearchBoxStoffe.SetFocus
Exit Sub
errHandler:
MsgBox Err.Number & " - " & Err.Description, vbOKOnly, "Error ..."
End Sub
The dynamic filter using the LIKE statement only seems to work
correctly when the length of the filter text is >= 3. Go below that
and it applies some wonky filtering.
I don't really know why this is happening, but try the below. It makes use of the Change() event and covers 4 scenarios:
Both filters applicable.
Search Box only.
Main category only.
Nothing (clear the filter).
Also, I don't know what the FilterStoffe() method does, but I assume it just applies the main filter only.
Private Sub SearchBoxStoffe_Change()
On Error GoTo Trap
Select Case True
'both filters
Case Len(SearchBoxStoffe.Text) > 0 And Not IsNull(Forms.HUB.FilterAlleLink.Value):
Form.Filter = "[bezeichnung] LIKE '*" & SearchBoxStoffe.Text & "*' AND [kategorie] = '" & Forms.HUB.FilterAlleLink.Value & "'"
FilterOn = True
'SearchBox only
Case Len(SearchBoxStoffe.Text) > 0:
Form.Filter = "[bezeichnung] LIKE '*" & SearchBoxStoffe.Text & "*'"
FilterOn = True
'FilterAlleLink only
Case Not IsNull(Forms.HUB.FilterAlleLink.Value):
Form.Filter = "[kategorie] = '" & Forms.HUB.FilterAlleLink.Value & "'"
FilterOn = True
'Nothing
Case Else:
FilterOn = False
Filter = vbNullString
End Select
Leave:
On Error Resume Next
SearchBoxStoffe.SetFocus
Exit Sub
Trap:
MsgBox Err.Number & " - " & Err.Description, vbOKOnly, "Error ..."
Resume Leave
End Sub
Keep in mind, within the Change() event, the Text property gets updated with every keystroke and when the control loses the focus, it gets copied to the Value property.
However, the Value is the default property when you just reference the control.
So this
Me.SearchBoxStoffe
is the same as this:
Me.SearchBoxStoffe.Value
There were 2 issues that prevented the searchbox from running as intended:
Object references in the project were created with 2 different language versions of access. Objects would call other objects using the formulation of one language, which in turn called objects using referencing in another language etc. In cases where fields and/or queries would return empty, this would cause some of the references to no longer function as intended. The result was the program running out of stack space, empty controls on subforms that returned empty queries, objects not being found and more.
The searchbox filter was lagging behind the text in the searchbox by one event. If entering a new search string, the applied filter would always be missing the last character when using SearchBoxStoffe in the filter statement. Entering "Wood" would cause the filter to apply "Woo" etc.
The solutions are the following:
Fix all the references in the file manually to either language version and do not mix them up going forward.
The Value of the search box SearchBoxStoffe is not yet updated on either the KeyUp or the Change event when entering a new character. This can be fixed by substituting the Text value instead, which is updated already. Simply change line 11 to Me.Form.Filter = "[bezeichnung] LIKE '*" & SearchBoxStoffe.Text & "*'" and line 13 to Me.Form.Filter = "[bezeichnung] LIKE '*" & SearchBoxStoffe.Text & "*' AND [kategorie] = '" & Forms![HUB]![FilterAlleLink] & "'". The info originally came from #KostasK in his solution:
Keep in mind, within the Change() event, the Text property gets updated with every keystroke and when the control loses the focus, it gets copied to the Value property.
Which works too btw, just wasn't able to be verified since issue 1 prevented the code from running correctly. Answer by Kostas K.
Renaud Bompuis pulled together some great code. I want to put in font changes (e.g. bold) on a field result within the Dialog.RichText format.
I'm trying to get the result of CaptureEmail to be bold. The box just makes CaptureEmail bold. The value doesn't show up. If I remove the <strong> from the code, the email shows up, but not bold.
Private Sub Other_Email_BeforeUpdate(Cancel As Integer)
' https://www.devhut.net/2016/08/18/validate-e-mail-addresses/
Dim ClickResult As VbMsgBoxResultEx
Dim CaptureEmail
Dim html
CaptureEmail = Me.Other_Email
If CaptureEmail = 0 Then
Exit Sub
ElseIf CaptureEmail > 0 Then
If ValidateEmail(Me.Other_Email) = False Then
ClickResult = Dialog.RichBox("The inputted e-mail " & _
<strong>[CaptureEmail]</strong> & _
" does not appear to be a valid Email_Address. " & "<p/>" & _
"Would you like to recheck it before adding it?", _
vbYesNo + vbCritical, "Invalid Entry", , , 0, False, False, False)
If (ClickResult = vbYes) Then
Cancel = True
ElseIf (ClickResult = vbNo) Then
Exit Sub
End If
ElseIf ValidateEmail(Me.Other_Email) = True Then
Exit Sub
End If
End If
End Sub
The main issue with your code is the concatenation of the first argument supplied to the RichBox method:
"The inputted e-mail " & <strong>[CaptureEmail]</strong> & " does not appear to be a valid Email_Address. " & "<p/>" & _
"Would you like to recheck it before adding it?"
Since <strong> & </strong> are literal strings, they should be included as part of the content of the strings that are surrounded by double-quotes, e.g.:
"The inputted e-mail <strong>" & CaptureEmail & "</strong> does not appear to be a valid Email_Address. "
You also have some malformed HTML here:
"<p/>"
Presumably, this should be:
"<p>The inputted e-mail <strong>" & CaptureEmail & "</strong> does not appear to be a valid Email_Address.</p>" & _
"<p>Would you like to recheck it before adding it?</p>"
You also seem to be mixing data types -
You initially assign the value of the form control Other_Email to your variable CaptureEmail:
CaptureEmail = Me.Other_Email
And you then treat CaptureEmail as an integer:
If CaptureEmail = 0 Then
Exit Sub
ElseIf CaptureEmail > 0 Then
However, based on the content of the message box, it would imply that CaptureEmail actually contains a string:
The inputted e-mail " & CaptureEmail & " does not appear to be a valid Email_Address.
A few other observations about your code:
If CaptureEmail = 0 Then
Exit Sub
ElseIf CaptureEmail > 0 Then
Given that you only wish to proceed when CaptureEmail is greater than zero, only test is required:
If CaptureEmail > 0 Then
...
End If
Similarly, later in the code, you have the following:
If ValidateEmail(Me.Other_Email) = False Then
...
ElseIf ValidateEmail(Me.Other_Email) = True Then
Exit Sub
End If
Since ValidateEmail returns a boolean value with only two possible values, it is not necessary to test both since if the return is not False, then it must be True and vice-versa.
As such, the code may become:
If Not ValidateEmail(Me.Other_Email) Then
...
End If
The same logic could be applied here:
If (ClickResult = vbYes) Then
Cancel = True
ElseIf (ClickResult = vbNo) Then
Exit Sub
End If
Since, for any result other than vbYes, you aren't performing any action.
i hope i understood correctly and it helps, you want "Would you like to recheck it before adding it?" to be bold as well.
Then you need to encapsulate the same between the tags<strong></strong>
The same way [CaptureEmail] is in between those tags in your code
I'm currently building a form where a user can look up a tool based on the description or part number.
I want user to be able to type any letters into the combobox that I have tied to a query listing all my tools and the combobox will repopulate itself with the tools most similar to what is present in their combobox. For example, if they start typing wre, then tools that have similar characters will start appearing in the combobox such as wrench, torque wrench, power wrench, etc.
I've tried looking around for other people's solutions to this but either I didn't fully comprehend the existing solution (I'm fairly new to Access) or it wasn't what I was looking for. I've seen that people suggested using a listbox instead but I really don't want to go down that route.
I was thinking about using what the user types in the combobox and my VBA code will pick up the "change event" and requery the combobox on the fly by using their input as the like criteria for the new query.
Is this a possible route? Will it be slower? Is there a better route?
I'm hoping someone can show some examples on how to achieve what I'm looking for.
The search as you type feature is very useful! With a textbox and a listbox, you can setup a dynamic search tool that will filter a list for approximate matches as you type. The textbox has four events associated with it, as seen here.
The code behind the form looks like this. Pay attention to the part in bold. This is where we create a string of SQL commands, and utilize the SQL Like operator, to get dynamic matches as we type. Pay attention to the text in bold below.
Option Compare Database
Option Explicit On
Private blnSpace As Boolean 'INCLUDE THIS LINE ON YOUR FORM
Private Sub btnClearFilter_Click()
'CODE FOR THE RED "X" BUTTON TO CLEAR THE FILTER AND SHOW ALL
On Error Resume Next
Me.txtSearch.Value = ""
txtSearch_Change()
End Sub
Private Sub txtSearch_Change()
'CODE THAT HANDLES WHAT HAPPENS WHEN THE USER TYPES IN THE SEARCH BOX
Dim strFullList As String
Dim strFilteredList As String
If blnSpace = False Then
Me.Refresh 'refresh to make sure the text box changes are actually available to use
'specify the default/full rowsource for the control
strFullList = "SELECT RecordID, First, Last FROM tblNames ORDER BY First;"
'specify the way you want the rowsource to be filtered based on the user's entry
strFilteredList = "SELECT RecordID, First, Last FROM tblNames WHERE [First] LIKE ""*" & Me.txtSearch.Value &
"*"" OR [Last] LIKE ""*" & Me.txtSearch.Value & "*"" ORDER BY [First]"
'run the search
fLiveSearch Me.txtSearch, Me.lstItems, strFullList, strFilteredList, Me.txtCount
End If
End Sub
Private Sub txtSearch_KeyPress(KeyAscii As Integer)
'NECESSARY TO IDENTIFY IF THE USER IS HITTING THE SPACEBAR
'IN WHICH CASE WE WANT TO IGNORE THE INPUT
On Error GoTo err_handle
If KeyAscii = 32 Then
blnSpace = True
Else
blnSpace = False
End If
Exit Sub
err_handle:
Select Case Err.Number
Case Else
MsgBox "An unexpected error has occurred: " & vbCrLf & Err.Description &
vbCrLf & "Error " & Err.Number & "(" & Erl() & ")"
End Select
End Sub
Private Sub txtSearch_GotFocus()
' USED TO REMOVE THE PROMPT IF THE CONTROL GETS FOCUS
On Error Resume Next
If Me.txtSearch.Value = "(type to search)" Then
Me.txtSearch.Value = ""
End If
End Sub
Private Sub txtSearch_LostFocus()
' USED TO ADD THE PROMPT BACK IN IF THE CONTROL LOSES FOCUS
On Error Resume Next
If Me.txtSearch.Value = "" Then
Me.txtSearch.Value = "(type to search)"
End If
End Sub
Finally, in a regular module, you will need this script.
Option Compare Database
Option Explicit On
'************* Code Start **************
' This code was originally written by OpenGate Software
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
' OpenGate Software http://www.opengatesw.net
Function fLiveSearch(ctlSearchBox As TextBox, ctlFilter As Control,
strFullSQL As String, strFilteredSQL As String, Optional ctlCountLabel As Control)
Const iSensitivity = 1 'Set to the number of characters the user must enter before the search starts
Const blnEmptyOnNoMatch = True 'Set to true if you want nothing to appear if nothing matches their search
On Error GoTo err_handle
'restore the cursor to where they left off
ctlSearchBox.SetFocus
ctlSearchBox.SelStart = Len(ctlSearchBox.Value) + 1
If ctlSearchBox.Value <> "" Then
'Only fire if they've input more than two characters (otherwise it's wasteful)
If Len(ctlSearchBox.Value) > iSensitivity Then
ctlFilter.RowSource = strFilteredSQL
If ctlFilter.ListCount > 0 Then
ctlSearchBox.SetFocus
ctlSearchBox.SelStart = Len(ctlSearchBox.Value) + 1
Else
If blnEmptyOnNoMatch = True Then
ctlFilter.RowSource = ""
Else
ctlFilter.RowSource = strFullSQL
End If
End If
Else
ctlFilter.RowSource = strFullSQL
End If
Else
ctlFilter.RowSource = strFullSQL
End If
'if there is a count label, then update it
If IsMissing(ctlCountLabel) = False Then
ctlCountLabel.Caption = "Displaying " & Format(ctlFilter.ListCount - 1, "#,##0") & " records"
End If
Exit Function
err_handle:
Select Case Err.Number
Case 91 'no ctlCountLabel
'exit
Case 94 'null string
'exit
Case Else
MsgBox "An unexpected error has occurred: " & vbCrLf & Err.Description &
vbCrLf & "Error " & Err.Number & vbCrLf & "Line: " & Erl()
End Select
End Function
The code comes from this link:
http://www.opengatesw.net/ms-access-tutorials/Access-Articles/Search-As-You-Type-Access.html
I started a thread here: Access Form Combobox Partial Filter but it was a bit too specific, and now that I moved past that, I am struggling to get the behavior I want.
Here is the layout:
A form with the detail hidden. The header has an unbound combobox for filtering the form. Once there is a filter to apply, that record is set for the filter on the form, and the detail is shown. The users want to be able to type in the combo, for partial matches, instead of only being able to click the drop down and click to choose an option.
This is the rowsource of the combo:
SELECT [vw_Info_Records]![recordName] & " (" & [vw_Info_Records]![recordNo] & ")" AS frecord, vw_Info_Records.INF_RID
FROM vw_Info_Records
WHERE ((([vw_Info_Records]![recordName] & " (" & [vw_Info_Records]![recordNo] & ")") Like "*" & [Forms]![frmrecords]![cboFindrecord] & "*"))
ORDER BY [vw_Info_Records]![recordName] & " (" & [vw_Info_Records]![recordNo] & ")";
It is set to auto-expand Yes. It is not bound to anything, and limit to list is set to yes.
This is the onchange event:
Private Sub cboFindRecord_Change()
Dim MyCriteria As String
If Me.cboFindRecord.SelStart > 0 Then
Me.cboFindRecord.Dropdown
End If
End Sub
This is the after update:
Private Sub cboFindRecord_AfterUpdate()
Dim Criteria As String
Dim myfilter As String
If Me.cboFindRecord.ListIndex = -1 Then
Me.Form.Filter = ""
Me.FilterOn = False
Me.Detail.Visible = False
Else
Criteria = "[INF_RID] = " & Me.cboFindRecord.Column(1)
With Me.Form
.Filter = Criteria
.FilterOn = True
End With
Me.Detail.Visible = True
End If
End Sub
The first character that is typed in, makes the dropdown expand, and filter to any results that contain that character. Any subsequent characters, and the drop down list doesn't update the filter to re-filter based on the added characters. If I add a requery in the change, I get an error about saving the field, before I do a requery. It wants me to set that "filter" value as a value for the combo, which I wouldn't do, because it's really an in string filter. The user still needs to pick a value from whatever is left in the list, before I can filter the form to that record.
Thanks for any advice as to how to fix this!
I have never used Outlook VBA (2010), but my manager tasked me to create a user form that sends IT requests and IS requests. I have the custom form created, where I gather all my text fields and print the text to a single text box.
This action is all defined within Sub CommandButton1_Click(), which ends with Send(). Within the sub, I have something like this for all text boxes:
Set Sj =Item.GetInspector.ModifiedFormPages("P.2").Controls("Subject_Text")
Set YNbox = Item.GetInspector.ModifiedFormPages("P.2").Controls("YNBox")
Set Rbox = Item.GetInspector.ModifiedFormPages("P.2").Controls("ReasonBox")
What I want to know is how do I take the texts within "P.2" and paste it into the Message area of "Message" Page?
Here is the code snippet for the printing out to a single text box:
FinalBox.Text = "Subject: " & Sj.Text & vbCrLf & _
vbCrLf & "Can work around the issue?: " & YNbox.Text & _
vbCrLf & "Reason For Ticketing: " & Rbox.Text & _
vbCrLf & "Department: " & Dbox.Text & _
vbCrLf & "Impact: " & Ibox.Text & _
vbCrLf & "Urgency: " & Ubox.Text & _
vbCrLf & "System/Machine Number: " & Mbox.Text & _
vbCrLf & "Was trying to accomplish: " & Abox.Text & _
vbCrLf & "Has it occured before?: " & Bbox.Text & _
vbCrLf & "First Noticed: " & Tbox.Text & _
vbCrLf & "Others affected by the issue: " & Affbox.Text & _
vbCrLf & "Additonal Comments: " & Addbox.Text
So, how do I take this and append it to the actual message field in Message page?
.
Thank you very much!!
P.S. I've been having issues with MailItem.body and whenever I create an object, for example:
Dim objMsg As Object,
I get an error that says "Expected end of statement"... I understand VB and VBA is different, but I didn't think it'd be giving me this much headache.
Edit:
Hello dbMitch and Tony Dallimore, thanks for helping me clarify my questions. Like I mentioned, I am a mere beginner when it comes to VBA, and I Just wanted to
`Sub Commandbutton
Set Sj = Item.GetInspector.ModifiedFormPages("P.2").Controls("Subject_Text")
Set YNbox = Item.GetInspector.ModifiedFormPages("P.2").Controls("YNBox")
Set Rbox = Item.GetInspector.ModifiedFormPages("P.2").Controls("ReasonBox")
Set Dbox = Item.GetInspector.ModifiedFormPages("P.2").Controls("DepartmentDropbox")
Set Mbox = Item.GetInspector.ModifiedFormPages("P.2").Controls("MachineBox")
Set Ibox = Item.GetInspector.ModifiedFormPages("P.2").Controls("ImpactBox")
Set Ubox = Item.GetInspector.ModifiedFormPages("P.2").Controls("UrgencyBox")
Set Abox = Item.GetInspector.ModifiedFormPages("P.2").Controls("AccomplishBox")
Set Bbox = Item.GetInspector.ModifiedFormPages("P.2").Controls("BeforeText")
Set Tbox = Item.GetInspector.ModifiedFormPages("P.2").Controls("Timebox")
Set Affbox = Item.GetInspector.ModifiedFormPages("P.2").Controls("AffectedBox")
Set Addbox = Item.GetInspector.ModifiedFormPages("P.2").Controls("AdditionalBox")
Set Tbox8 = Item.GetInspector.ModifiedFormPages("P.2").Controls("TextBox8")
Set MESBOX = Item.GetInspector.ModifiedFormPages("Message").Controls("Message")
Tbox8.Text = "Subject: " & Sj.Text & vbCrLf & _
vbCrLf & "Can work around the issue?: " & YNbox.Text & _
vbCrLf & "Reason For Ticketing: " & Rbox.Text & _
vbCrLf & "Department: " & Dbox.Text & _
vbCrLf & "Impact: " & Ibox.Text & _
vbCrLf & "Urgency: " & Ubox.Text & _
vbCrLf & "System/Machine Number: " & Mbox.Text & _
vbCrLf & "Was trying to accomplish: " & Abox.Text & _
vbCrLf & "Has it occured before?: " & Bbox.Text & _
vbCrLf & "First Noticed: " & Tbox.Text & _
vbCrLf & "Others affected by the issue: " & Affbox.Text & _
vbCrLf & "Additonal Comments: " & Addbox.Text
Send
End Sub
`
Sub I found online that is suppose to take an item and append the text onto message body. There seems to be an error every time I try to declare the object's type (Ex. ____ As _____). I was not sure how to modify this to make it fit with my code, but the error is thrown at Dim objItem As Object that says
Expected end of statement
Sub TestAppendText()
Dim objItem As Object
Dim thisMail As Outlook.MailItem
'On Error Resume Next
Set objItem = Application.ActiveExplorer.Selection(1)
If Not objItem Is Nothing Then
If objItem.Class = olMail Then
Set thisMail = objItem
Call AppendTextToMessage(thisMail, "Some text added at " & Now())
End If
End If
Set objItem = Nothing
Set thisMail = Nothing
End Sub
Sub AppendTextToMessage(ByVal objMail As Outlook.MailItem, ByVal strText As String)
Dim objCDO As MAPI.Session
Dim objMsg As MAPI.Message
Dim objField As MAPI.Field
Set objCDO = CreateObject("MAPI.Session")
objCDO.Logon "", "", False, False
If Not objMail.EntryID = "" Then
Set objMsg = objCDO.GetMessage(objMail.EntryID, _
objMail.Parent.StoreID)
objMsg.Text = objMsg.Text & vbCrLf & strText
objMsg.Update True, True
Set objField = objMsg.Fields(CdoPR_RTF_COMPRESSED)
If Not objField Is Nothing Then
objField.Delete
objMsg.Update True, True
End If
Set objField = Nothing
Set objField = objMsg.Fields(CdoPR_RTF_SYNC_BODY_COUNT)
If Not objField Is Nothing Then
objField.Delete
objMsg.Update True, True
End If
Else
strMsg = "You must save the item before you add text. " & _
"Do you want to save the item now?"
intAns = MsgBox(strMsg, vbYesNo + vbDefaultButton1, "Append Text to Message")
If intAns = vbYes Then
Call AppendTextToMessage(objMail, strText)
Else
Exit Sub
End If
End If
Set objMsg = Nothing
objCDO.Logoff
Set objCDO = Nothing
End Sub
I've also tried using a CDO object, but it gives me an error that says
ActiveX component can't create object: 'CDONTS.NewMail'
Set Item1 = Item.MessageClass
Set objCDONTS = CreateObject ("CDONTS.NewMail")
objCDONTS.Body = Tbox8.Text
Item1.Message = "Hi"
I apologize if this seems very simple to others.. I just have 0 experience with VBA/VBScript and Outlook designs. That's why I'm here, to learn!
Please do not ask a question like this again. I do understand the difficulty of telling one’s manager that you lack the background to tackle a task. The typical response seems to be: “It is easy: just look it up on the internet.” In one sense this is true. There is nothing in the answer below that you could not find in other answers. What you lack is the background to identify the features you require and to fit them together to create the solution. VBA is not a difficult language but it has many significant differences from other languages that will confuse an experienced programmer new to VBA. The Outlook Object model takes time to master.
There are many online Excel VBA and Outlook VBA tutorials. I think the Excel VBA tutorials are better. If you are asked to perform a similar task again, you must insist on having the time to study first. These answers of mine might help:
Update excel sheet based on outlook mail
How to copy Outlook mail message into excel using VBA or Macros
I wanted to create a complete solution since I did not believe another snippet would help. You need: “This works. Adjust it step by step to your exact requirement.”
I am not familiar with custom forms and can find nothing that says what advantage they offer over user forms which work with all versions of VBA. I did not want to take the time to study custom forms particularly as I have code for user forms that I can easily adjust to your requirement. If your custom form is working to your satisfaction, replace that part of my solution.
There are five parts to my solution:
The user form.
The first part of the subroutine SendTicket() which loads the user form and calls it to get data from the user.
The subroutine UserForm_Initialize() within the user form’s code which builds the form from parameters supplied by SendTicket().
The subroutine CommandButton1_Click() which performs minimal validation of the user’s data and stores it for SendTicket().
The second part of the subroutine SendTicket() which builds the email from the user’s data and sends it to the IT department.
1. The user form
I inserted a new user form, adjusted its size and added controls. If you do not know how to do this then look at one of the tutorials that introduce user forms.
If I add a label control to a user form and name it X, I can, for example:
Move it by changing X.Top.
Display some text by changing X.Caption.
The user form includes a Collection named Controls. A collection is what most languages call an unsorted list. Within Controls there will be an entry for every control (label, text box, command button, etc.) on the form. If the label X is the first control on the user form, I can access its properties as Controls(0).Top and Controls(0).Caption. This means I can have code specific to label X that reference it by name or I can have general code that handles all or selected labels by their position within Controls. For your requirement, I believed general code would be easier so that is what I have provided.
I created a label control and a text box control. I left the default names but changed some properties:
LABEL TEXT BOX
* Name Label1 TextBox1
Caption Prompt/Name
Font Tahoma 10 Tahoma 10
Height 12 18
Left 12 230
* Multiline True
* Scrollbars 2 - frmScrollBarsVertical
TextAlign 3 – frmTextAlighRight 1 – frmTextAlignLegt
Text/Value abcdefghijklmnopqrstuvwyz
* Visible False False
Width 200 400
* Word wrap True True
Properties starting “*” are important. The others are because I like the way they affect the form’s appearance.
In the UK, “Label1” and “TextBox1” are the default names for the first label and textbox. With Excel, default names vary with the local language; I do not know if this is true for Outlook. Within the code, it tells you how to change the default names if necessary.
My code assumes the captions for the labels will fit on a single line but the text entered into the text boxes may require several lines.
Having created my standard label and text box, I selected them, copied them, pasted them and then moved the copies so they were exactly under the first pair. I repeated this with the four controls then the eight controls and finally the sixteen controls. I ended with a column of sixteen labels and a column of sixteen text boxes. I was not concerned with the vertical position of the controls; I handle that later. If either column is not perfectly aligned, you can select a column and set the Left property for the entire group. I have created forms with hundreds of controls with acceptable performance so add more if you wish.
I created a command button. I lined it up with the text boxes but made the font larger. I retained the default name and caption.
By creating the command button last, the controls are in the correct tab order. The form opens with the cursor in the first (top) field and each tab takes the cursor to the next field and then to the button.
Finally, I set the width of the form so it was a little wider than the controls. I set the height so it was close to the screen height which on my laptop is about 560. It is possible to get the screen height from the system but that is beyond the scope of this answer. I set the caption to “Report issue”. I named it P2 which the closest I can get to your name (P.2 is an invalid name for a user form). The result was:
** 2. Part 1 of subroutine SendTicket()**
A macro cannot directly send parameters to a user form or receive values back. It must use global variables. P2Params is the global I use to pass data to the user form and I use P2Values to pass data back.
P2Params = Array("Subject", …) is the statement that loads P2Paramswith parameters. The first three parameters are "Subject", 18, True which specify the first text box. The prompt/name is “Subject”, the height is 18 and it is mandatory. Each further set of three parameters defines another text box.
I could have defined all this information within the form but getting a form like this looking the way you want can be very fussy particularly if you change your mind about the height of a text box so all the lower ones have to be moved down. With this approach you can change a text box’s height or change the sequence or add a new field with no hassle at all. Note: height defines the height allocated to the control. On my laptop and with my choice of font, 54 is enough for four lines. If the user types a fifth line, the scroll bars will appear against the relevant control so the user can see all the lines. You specify height of each text box based on some average or typical ticket but it does not matter if the user wants to enter more text than you expected.
Load P2 loads the form into memory and calls UserForm_Initialize() to initialise the form. .Show vbModal passes control to the form. Control is not returned until the user does something to return control. In this case, clicking the command button returns control providing the entered values pass the validation code.
3. The subroutine UserForm_Initialize()
I do not intend to say too much about this sub-routine. Comments within the code fully explain what the code does and the image below shows the result:
If you look down the parameters in P2Params. You can see where this layout came from. The beauty of this approach is that with a different set of parameters, a very different form can be produced. A requirement to import a list of text values is not uncommon so I have used variations of this code before and will again.
4. The subroutine CommandButton1_Click()
The user can enter values into the text boxes in required. Once they are correct, the user clicks the command button which was been re-captioned “Send” by the first part of subroutine SendTicket().
This routine validates that all mandatory fields have a value. I have implemented permitted ranges and other validation but this is sufficient for your requirement. If the field values are acceptable, the routine loads the entered values into array P2Values. As I said, only by storing values in a global variable can a user form return values to the caller.
5. The second part of the subroutine SendTicket()
This code takes the values from P2Values builds the email and sends it. I have send emails to an experimental Gmail account. You will need to replace the recipient with the address of your IT Department.
Summary
There is a lot here for you to think about. Work through it slower and come back with questions if necessary
SendTicket()
Option Explicit
Public Type FieldDtl
CtrlLabel As Long
CtrlTextBox As Long
Height As Long
Mandatory As Boolean
Prompt As String
End Type
Public P2Params As Variant
Public P2Values() As String
Sub SendTicket()
Dim InxFld As Long
Dim InxPrm As Long
Dim MailItemCrnt As MailItem
P2Params = Array("Subject", 18, True, _
"Can you work around the issue?", 18, True, _
"Reason For Ticketing", 30, True, _
"Department", 18, False, _
"Impact", 18, True, _
"Urgency", 18, True, _
"System/Machine Number", 18, True, _
"Was trying to accomplish", 54, True, _
"Has it occured before?", 18, True, _
"First Noticed", 18, False, _
"Others affected by the issue", 42, True, _
"Additional Comments", 54, True)
' Used to test total height of control exceeding height of screen
'P2Params = Array("Subject", 50, True, _
' "Can you work around the issue?", 50, True, _
' "Reason For Ticketing", 50, True, _
' "Department", 50, False, _
' "Impact", 50, True, _
' "Urgency", 50, True, _
' "System/Machine Number", 50, True, _
' "Was trying to accomplish", 54, True, _
' "Has it occured before?", 50, True, _
' "First Noticed", 50, False, _
' "Others affected by the issue", 54, True, _
' "Additional Comments", 54, True)
Load P2
With P2
.CommandButton1.Caption = "Send"
.Show vbModal
End With
' The bounds of P2Values are 1 to number of fields
' The bounds of P2Params could be 1 to NumberOfFields*3 but is almost
' certainly 0 to NumberOfFields*3-1
Set MailItemCrnt = CreateItem(olMailItem)
With MailItemCrnt
.BodyFormat = olFormatPlain
.Recipients.Add "AbbeyRuins33#gmail.com"
.Subject = P2Values(1) ' Assumes subject is first field
.Body = P2Params(LBound(P2Params) + 3) & ": " & P2Values(2)
InxFld = 3
For InxPrm = LBound(P2Params) + 6 To UBound(P2Params) Step 3
.Body = .Body & vbCrLf & P2Params(InxPrm) & ": " & P2Values(InxFld)
InxFld = InxFld + 1
Next
.Display
' .Send
End With
Set MailItemCrnt = Nothing
End Sub
Code for user form
Option Explicit
' In UK, the default name for a label is "LabelN" and the default name for a text box
' is "TextBoxN". In case the default name is different is non-English speaking
' countries, I use constants for these values. Change the value of these constants
' as necessary.
Const NameLabel As String = "Label"
Const NameTextBox As String = "TextBox"
' This code assumes there are N labels named NameLabel & 1 to NameLabel & N and
' N text boxes named NameTextBox & 1 to NameTextBox & N. NameLabelX is used to
' label TextBoxX which is used to obtain the Xth value from the user.
' User type FieldDtl is defined in the SendTicket module
Dim Fields() As FieldDtl
Private Sub CommandButton1_Click()
Dim ErrMsg As String
Dim InxFld As Long
' Check values have been entered for mandatory fields
ErrMsg = ""
For InxFld = 1 To UBound(Fields)
If Fields(InxFld).Mandatory And Controls(Fields(InxFld).CtrlTextBox).Text = "" Then
If ErrMsg <> "" Then
ErrMsg = ErrMsg & vbLf
End If
ErrMsg = ErrMsg & "Please enter a value for " & Fields(InxFld).Prompt
End If
Next
' No value entered for one or more mandatory fields
If ErrMsg <> "" Then
Call MsgBox(ErrMsg, vbOKOnly)
Exit Sub
End If
' Save values for caller
ReDim P2Values(1 To UBound(Fields))
For InxFld = 1 To UBound(Fields)
P2Values(InxFld) = Controls(Fields(InxFld).CtrlTextBox).Text
Next
Unload Me
End Sub
Private Sub UserForm_Initialize()
Const GapBetweenCtrls As Long = 5
Dim InxCtrl As Long
Dim InxFld As Long
Dim InxPrm As Long
Dim NumFields As Long
Dim NumParams As Long
Dim TopNext As Long
' Note: LBound(P2Params) can be zero or one but will almost certainly be zero.
' This code allows for either possibility.
NumParams = UBound(P2Params) - LBound(P2Params) + 1
Debug.Assert NumParams Mod 3 = 0
NumFields = NumParams / 3
ReDim Fields(1 To NumFields)
' Import values from P2Params
' P2Params must contain 3N paramerers where N is the number of values
' to be obtained from the user. The three values are:
' Prompt/Name for value.
' Height of value (so control can be sized for multi-line values).
' Mandatory? (True is a value must be entered)
InxFld = 1
For InxPrm = LBound(P2Params) To UBound(P2Params) Step 3
Fields(InxFld).Prompt = P2Params(InxPrm)
Fields(InxFld).Height = P2Params(InxPrm + 1)
Fields(InxFld).Mandatory = P2Params(InxPrm + 2)
InxFld = InxFld + 1
Next
' Controls can be accessed by name (for example Label1.Caption) or
' by position within the collection Controls (for example
' Controls(1).Caption). Add control numbers to Fields().
For InxCtrl = 0 To Controls.Count - 1
If Left$(Controls(InxCtrl).Name, Len(NameLabel)) = NameLabel Then
' Extract number at end of name
InxFld = CLng(Mid(Controls(InxCtrl).Name, Len(NameLabel) + 1))
If InxFld <= NumFields Then
' This control will be used
Fields(InxFld).CtrlLabel = InxCtrl
End If
ElseIf Left$(Controls(InxCtrl).Name, Len(NameTextBox)) = NameTextBox Then
InxFld = CLng(Mid(Controls(InxCtrl).Name, Len(NameTextBox) + 1))
If InxFld <= NumFields Then
' This control will be used
Fields(InxFld).CtrlTextBox = InxCtrl
End If
End If
Next
' For InxFld = 1 To NumFields
' Debug.Print Fields(InxFld).Name & " " & Fields(InxFld).Height & " " & _
' Fields(InxFld).Mandatory & " " & Fields(InxFld).CtrlLabel & _
' " " & Fields(InxFld).CtrlTextBox
' Next
' Now have information necessary to build form.
' This code assumes/relies on:
' * All properties of the textbox controls being correct
' except for Top and Height.
' * All properties of the label controls being correct except for Top.
' * The Height of the label controls being less than the Height of any
' Textbox control.
' * The Visible property of the label and textbox controls being false.
' * The Multiline property of the textbox controls being true
' * The Scrollbars property of the textbox controls being
' 2 = frmScrollBarsVertical
' * The Width of the label property being such that all captions fit.
TopNext = GapBetweenCtrls
For InxFld = 1 To NumFields
With Controls(Fields(InxFld).CtrlLabel)
.Top = TopNext
.Caption = Fields(InxFld).Prompt
.Visible = True
End With
With Controls(Fields(InxFld).CtrlTextBox)
.Top = TopNext
.Height = Fields(InxFld).Height
.Text = ""
.Visible = True
End With
TopNext = TopNext + Fields(InxFld).Height + GapBetweenCtrls
Next
With CommandButton1
.Top = TopNext
TopNext = TopNext + .Height + GapBetweenCtrls
End With
' Set scroll height so if total height of controls exceeds height
' of form, user can scroll from top to bottom.
ScrollHeight = TopNext
End Sub