And this.

[VBA] Option Compare Database
Option Explicit

Sub AddQueryCombo()
Dim cmdContracts As CommandBar
Dim cmdQueries As CommandBarComboBox
Dim db As Database
Dim qdf As QueryDef
Dim Exists


Set cmdContracts = CommandBars("Contracts")

Exists = IsCmdCtrl(cmdContracts, "cboqueries")

If Exists Then
Set cmdQueries = CommandBars.FindControl(msoControlComboBox, , "cboQueries")
Else
Set cmdQueries = cmdContracts.Controls.Add(msoControlComboBox, , "cboQueries")
cmdQueries.Tag = "cboQueries"

End If

Set db = CurrentDb
cmdQueries.Clear
cmdQueries.AddItem "New Query"
For Each qdf In db.QueryDefs
If Left(qdf.Name, 1) <> "~" Then
cmdQueries.AddItem qdf.Name
End If
Next
cmdQueries.ListIndex = 1
cmdQueries.Width = 130
End Sub

Function IsCmdCtrl(cmdBar, ctrlTag) As Boolean
Dim cmdctrl
For Each cmdctrl In cmdBar.Controls
IsCmdCtrl = (cmdctrl.Tag = ctrlTag)
If IsCmdCtrl Then Exit Function
Next
End Function
Function GotoQuery(qryView As Integer)

Dim qryName As String

qryName = CommandBars.FindControl(msoControlComboBox, , "cboQueries").Text
If qryName <> "New Query" Then
DoCmd.OpenQuery qryName, qryView
Else
NewQuery
End If
End Function

Public Function InStrRev(SearchText As String, FindText As String) As Long
Dim RevSearchText As String
Dim LengthSearchText As Long
Dim I%
LengthSearchText = Len(SearchText)

For I = LengthSearchText To 1 Step -1
RevSearchText = RevSearchText & Mid(SearchText, I, 1)
Next I
InStrRev = InStr(RevSearchText, FindText)
InStrRev = LengthSearchText - InStrRev + 1
End Function

Function IsQuery(qryName As String) As Boolean
' returns true if there is a query called qryName
Dim db As Database
Dim qdf As QueryDef
Set db = CurrentDb
For Each qdf In db.QueryDefs
IsQuery = (qdf.Name = qryName)
If IsQuery Then Exit Function
Next

End Function

Function IsTable(tblName As String) As Boolean
' returns true if there is a query called qryName
Dim db As Database
Dim tdf As TableDef
Set db = CurrentDb
For Each tdf In db.TableDefs
IsTable = (tdf.Name = tblName)
If IsTable Then Exit Function
Next

End Function

Public Function NewQuery() As Boolean
' this will create then open a new query called qryName
On Error GoTo Err_NewQuery
Dim qryName
Dim db As Database
qryName = InputBox("Please enter a name for the query:", "Create new query")
If qryName = "" Then
Exit Function

Else

Set db = CurrentDb
db.CreateQueryDef qryName
DoCmd.OpenQuery qryName, acViewDesign

End If
NewQuery = True

Exit_NewQuery:
Exit Function
Err_NewQuery:
MsgBox Err.Description, vbInformation, "Error message"
NewQuery = False
Resume Exit_NewQuery

End Function

Public Sub SearchProcs()
' this will search each form's module for a string
' and leave it open if it is found
Dim frm As Form, mdl As Module
Dim dbs As Database, ctr As Container, doc As Document
Dim X As Long
Dim strString As String
strString = InputBox("What text do you wish to search for?", "Search text")
If strString = "" Then Exit Sub
Set dbs = CurrentDb
Set ctr = dbs.Containers!Forms
For Each doc In ctr.Documents
If Not IsLoaded(doc.Name) Then DoCmd.OpenForm doc.Name, acDesign
Set frm = Forms(doc.Name)
Set mdl = frm.Module
Set mdl = frm.Module
If Not mdl.Find(strString, X, X, X, X) Then DoCmd.Close acForm, doc.Name
Next
End Sub

Function LetEdit(frmName As String, Optional ctrlFocus As String) As Boolean
' allows form frmName to be edited and sets the focus to
' control ctrlFocus
Dim frm As Form, ctrl As Control
Dim CType%
On Error GoTo Err_LetEdit
Set frm = Forms(frmName)
If Not (IsControl(frmName, ctrlFocus)) Then GoTo Exit_LetEdit
For Each ctrl In frm
CType = ctrl.ControlType
If (CType = acTextBox) Or (CType = acComboBox) Then
If Not ctrl.Locked Then ctrl.BackColor = vbWhite
End If
Next

frm.AllowEdits = True

DoCmd.GoToRecord acDataForm, frm.Name, acFirst

If Not IsMissing(ctrlFocus) Then
frm.Controls(ctrlFocus).SetFocus
End If

LetEdit = True
Exit_LetEdit:
Exit Function

Err_LetEdit:
MsgBox Err.Description, vbInformation, "Error message"
LetEdit = False
Resume Exit_LetEdit

End Function
[/VBA]