the Dlookup function retrieves single data from a table. Is there a function that works the opposite of this? Exports data selected from the form to a given table. It cannot be anything from SQL. Opposite to Dlookup??
Sure. If you insist on avoiding SQL:
Create a new update query in the designer.
Use =Forms!MyFormName!MyControl as the value (obviously substituting MyFormName and MyControl with the correct values).
Execute the update query (manually, or in code with CurrentDb.Execute "nameOfMyQuery")
You can use the RecordsetClone as source and DAO to copy the records.
Then, record the selected records with the mouse, and call a function similar to this:
Option Compare Database
Option Explicit
Public SubSelHeight As Integer
Public SubSelTop As Integer
Public Function GetSelectedFormRecords()
Dim Index As Long
Dim Form As Form
Dim Records As DAO.Recordset
Dim Copyset As DAO.Recordset
' Get the form and its recordset.
Set Form = Me ' or a subform: Me!NameOfSubformControl.Form
Set Records = Form.RecordsetClone
Set Copyset = CurrentDb.OpenRecordset("Select * From YourCopyTable")
' Move to the first record in the recordset.
Records.MoveFirst
' Move to the first selected record.
Records.Move SubSelTop - 1
For Index = 1 To SubSelHeight
' MsgBox Records!Id.Value
' Copy record.
Copyset.AddNew
Copyset.Field1.Value = Records.FieldX.Value
Copyset.Field2.Value = Records.FieldY.Value
Copyset.Field3.Value = Records.FieldZ.Value
' More fields.
Copyset.Update
Records.MoveNext
Next
Records.Close
Copyset.Close
End Function
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Const EmpiricMaxX As Single = 255
Debug.Print "Mouse X:", X
If X < EmpiricMaxX Then
' Mouse click on record selector.
MsgBox "Select"
End If
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
SubSelTop = Me.SelTop
SubSelHeight = Me.SelHeight
End Sub
good day!
i am using ms access and i want to know what will i do if i have 5 comboboxes in my form then 10 choices of name which connect in one table, how can make that if ever i select one of the name in list then the selected list will not show on the 2nd combobox list. there are 5 comboboxes in my list. look like this
Consider switching to value list and add the items the boxes using a query in VBA. Then delete and add items from other boxes when a change is made.
Option Explicit
' Have to use global variables because combobox.oldValue is not reliable
Dim strOld1 As String
Dim strOld2 As String
Dim strOld3 As String
Dim strOld4 As String
Dim strOld5 As String
Private Sub frmMain_Load()
Dim rsNames as Recordset
' Get names
Set rsNames = CurrentDB.OpenRecordset( _
"SELECT [Names] " & _
"FROM tblPerson")
' Setup recordset
If rsNames.RecordCount > 0 Then
rsNames.MoveLast
rsNames.MoveFirst
' Add names to all boxes
Do While Not rsNames.EOF
cboNames1.addItem rsNames.Field("Name")
cboNames2.addItem rsNames.Field("Name")
cboNames3.addItem rsNames.Field("Name")
cboNames4.addItem rsNames.Field("Name")
cboNames5.addItem rsNames.Field("Name")
rsNames.MoveNext
End If
' Dispose recordset asap
Set rsNames = Nothing
End Sub
Private Sub addRemoveItem(ByRef thisCombo As Variant, ByRef oldValue As String)
Dim arrCombos(1 To 5) As ComboBox
Dim otherCombo As Variant
Dim intIndex As Integer
' Get a list of all combo boxes
Set arrCombos(1) = Me.cboNames1
Set arrCombos(2) = Me.cboNames2
Set arrCombos(3) = Me.cboNames3
Set arrCombos(4) = Me.cboNames4
Set arrCombos(5) = Me.cboNames5
' Check for comboboxes that are not the one changed
For Each otherCombo in arrCombos
If otherCombo.ControlName <> thisCombo.ControlName Then
' Search for exisitng item
IntIndex = 0
Do While otherCombo.itemData(intIndex) <> thisCombo.Value _
And intIndex < otherCombo.ListCount
intIndex = intIndex + 1
Loop
' Remove the found item
otherCombo.removeItem intIndex
' Add unselected value back
If oldValue <> "" Then
otherCombo.addItem oldValue
End if
Next
' Change the old value to the new one
oldValue = thisCombo.Value
End Sub
Private Sub cboName1_Change()
RemoveAddItem Me.cboName1, strOld1
End Sub
Private Sub cboName2_Change()
RemoveAddItem Me.cboName2, strOld2
End Sub
Private Sub cboName3_Change()
RemoveAddItem Me.cboName3, strOld3
End Sub
Private Sub cboName4_Change()
RemoveAddItem Me.cboName4, strOld4
End Sub
Private Sub cboName5_Change()
RemoveAddItem Me.cboName5, strOld5
End Sub
Sorry, I did this on a phone...
I've read a lot about SQL injection, and using parameters, from sources like bobby-tables.com. However, I'm working with a complex application in Access, that has a lot of dynamic SQL with string concatenation in all sorts of places.
It has the following things I want to change, and add parameters to, to avoid errors and allow me to handle names with single quotes, like Jack O'Connel.
It uses:
DoCmd.RunSQL to execute SQL commands
DAO recordsets
ADODB recordsets
Forms and reports, opened with DoCmd.OpenForm and DoCmd.OpenReport, using string concatenation in the WhereCondition argument
Domain aggregates like DLookUp that use string concatenation
The queries are mostly structured like this:
DoCmd.RunSQL "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE ID = " & Me.SomeTextbox
What are my options to use parameters for these different kinds of queries?
This question is intended as a resource, for the frequent how do I use parameters comment on various posts
There are many ways to use parameters in queries. I will try to provide examples for most of them, and where they are applicable.
First, we'll discuss the solutions unique to Access, such as forms, reports and domain aggregates. Then, we'll talk about DAO and ADO.
Using values from forms and reports as parameters
In Access, you can directly use the current value of controls on forms and reports in your SQL code. This limits the need for parameters.
You can refer to controls in the following way:
Forms!MyForm!MyTextbox for a simple control on a form
Forms!MyForm!MySubform.Form!MyTextbox for a control on a subform
Reports!MyReport!MyTextbox for a control on a report
Sample implementation:
DoCmd.RunSQL "INSERT INTO Table1(Field1) SELECT Forms!MyForm!MyTextbox" 'Inserts a single value
DoCmd.RunSQL "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE ID = Forms!MyForm!MyTextbox" 'Inserts from a different table
This is available for the following uses:
When using DoCmd.RunSQL, normal queries (in the GUI), form and report record sources, form and report filters, domain aggregates, DoCmd.OpenForm and DoCmd.OpenReport
This is not available for the following uses:
When executing queries using DAO or ADODB (e.g. opening recordsets, CurrentDb.Execute)
Using TempVars as parameters
TempVars in Access are globally available variables, that can be set in VBA or using macro's. They can be reused for multiple queries.
Sample implementation:
TempVars!MyTempVar = Me.MyTextbox.Value 'Note: .Value is required
DoCmd.RunSQL "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE ID = TempVars!MyTempVar"
TempVars.Remove "MyTempVar" 'Unset TempVar when you're done using it
Availability for TempVars is identical to that of values from forms and reports: not available for ADO and DAO, available for other uses.
I recommend TempVars for using parameters when opening forms or reports over referring to control names, since if the object opening it closes, the TempVars stay available. I recommend using unique TempVar names for every form or report, to avoid weirdness when refreshing forms or reports.
Using custom functions (UDFs) as parameters
Much like TempVars, you can use a custom function and static variables to store and retrieve values.
Sample implementation:
Option Compare Database
Option Explicit
Private ThisDate As Date
Public Function GetThisDate() As Date
If ThisDate = #12:00:00 AM# Then
' Set default value.
ThisDate = Date
End If
GetThisDate = ThisDate
End Function
Public Function SetThisDate(ByVal NewDate As Date) As Date
ThisDate = NewDate
SetThisDate = ThisDate
End Function
and then:
SetThisDate SomeDateValue ' Will store SomeDateValue in ThisDate.
DoCmd.RunSQL "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE [SomeDateField] = GetThisDate()"
Also, a single function with an optional parameter may be created for both setting and getting the value of a private static variable:
Public Function ThisValue(Optional ByVal Value As Variant) As Variant
Static CurrentValue As Variant
' Define default return value.
Const DefaultValue As Variant = Null
If Not IsMissing(Value) Then
' Set value.
CurrentValue = Value
ElseIf IsEmpty(CurrentValue) Then
' Set default value
CurrentValue = DefaultValue
End If
' Return value.
ThisValue = CurrentValue
End Function
To set a value:
ThisValue "Some text value"
To get the value:
CurrentValue = ThisValue
In a query:
ThisValue "SomeText" ' Set value to filter on.
DoCmd.RunSQL "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE [SomeField] = ThisValue()"
Using DoCmd.SetParameter
The uses of DoCmd.SetParameter are rather limited, so I'll be brief. It allows you to set a parameter for use in DoCmd.OpenForm, DoCmd.OpenReport and some other DoCmd statements, but it doesn't work with DoCmd.RunSQL, filters, DAO and ADO.
Sample implementation
DoCmd.SetParameter "MyParameter", Me.MyTextbox
DoCmd.OpenForm "MyForm",,, "ID = MyParameter"
Using DAO
In DAO, we can use the DAO.QueryDef object to create a query, set parameters, and then either open up a recordset or execute the query. You first set the queries' SQL, then use the QueryDef.Parameters collection to set the parameters.
In my example, I'm going to use implicit parameter types. If you want to make them explicit, add a PARAMETERS declaration to your query.
Sample implementation
'Execute query, unnamed parameters
With CurrentDb.CreateQueryDef("", "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE Field1 = ?p1 And Field2 = ?p2")
.Parameters(0) = Me.Field1
.Parameters(1) = Me.Field2
.Execute
End With
'Open recordset, named parameters
Dim rs As DAO.Recordset
With CurrentDb.CreateQueryDef("", "SELECT Field1 FROM Table2 WHERE Field1 = FirstParameter And Field2 = SecondParameter")
.Parameters!FirstParameter = Me.Field1 'Bang notation
.Parameters("SecondParameter").Value = Me.Field2 'More explicit notation
Set rs = .OpenRecordset
End With
While this is only available in DAO, you can set many things to DAO recordsets to make them use parameters, such as form recordsets, list box recordsets and combo box recordsets. However, since Access uses the text, and not the recordset, when sorting and filtering, those things may prove problematic if you do.
Using ADO
You can use parameters in ADO by using the ADODB.Command object. Use Command.CreateParameter to create parameters, and then append them to the Command.Parameters collection.
You can use the .Parameters collection in ADO to explicitly declare parameters, or pass a parameter array to the Command.Execute method to implicitly pass parameters.
ADO does not support named parameters. While you can pass a name, it's not processed.
Sample implementation:
'Execute query, unnamed parameters
Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
With cmd
Set .ActiveConnection = CurrentProject.Connection 'Use a connection to the current database
.CommandText = "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE Field1 = ? And Field2 = ?"
.Parameters.Append .CreateParameter(, adVarWChar, adParamInput, Len(Me.Field1), Me.Field1) 'adVarWChar for text boxes that may contain unicode
.Parameters.Append .CreateParameter(, adInteger, adParamInput, 8, Me.Field2) 'adInteger for whole numbers (long or integer)
.Execute
End With
'Open recordset, implicit parameters
Dim rs As ADODB.Recordset
Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
With cmd
Set .ActiveConnection = CurrentProject.Connection 'Use a connection to the current database
.CommandText = "SELECT Field1 FROM Table2 WHERE Field1 = #FirstParameter And Field2 = #SecondParameter"
Set rs = .Execute(,Array(Me.Field1, Me.Field2))
End With
The same limitations as opening DAO recordsets apply. While this way is limited to executing queries and opening recordsets, you can use those recordsets elsewhere in your application.
I have built a fairly basic query builder class to get around the mess of string concatenation and to handle the lack of named parameters. Creating a query is fairly simple.
Public Function GetQuery() As String
With New MSAccessQueryBuilder
.QueryBody = "SELECT * FROM tblEmployees"
.AddPredicate "StartDate > #StartDate OR StatusChangeDate > #StartDate"
.AddPredicate "StatusIndicator IN (#Active, #LeaveOfAbsence) OR Grade > #Grade"
.AddPredicate "Salary > #SalaryThreshhold"
.AddPredicate "Retired = #IsRetired"
.AddStringParameter "Active", "A"
.AddLongParameter "Grade", 10
.AddBooleanParameter "IsRetired", False
.AddStringParameter "LeaveOfAbsence", "L"
.AddCurrencyParameter "SalaryThreshhold", 9999.99#
.AddDateParameter "StartDate", #3/29/2018#
.QueryFooter = "ORDER BY ID ASC"
GetQuery = .ToString
End With
End Function
The output of the ToString() method looks like:
SELECT * FROM tblEmployees WHERE 1 = 1 AND (StartDate > #3/29/2018# OR StatusChangeDate > #3/29/2018#) AND (StatusIndicator IN ('A', 'L') OR Grade > 10) AND (Salary > 9999.99) AND (Retired = False) ORDER BY ID ASC;
Each predicate is wrapped in parens to handle linked AND/OR clauses, and parameters with the same name only have to be declared once. Full code is at my github and reproduced below. I also have a version for Oracle passthrough queries that uses ADODB parameters. Eventually, I'd like to wrap both in an IQueryBuilder interface.
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "MSAccessQueryBuilder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'#Folder("VBALibrary.Data")
'#Description("Provides tools to construct Microsoft Access SQL statements containing predicates and parameters.")
Option Explicit
Private Const mlngErrorNumber As Long = vbObjectError + 513
Private Const mstrClassName As String = "MSAccessQueryBuilder"
Private Const mstrParameterExistsErrorMessage As String = "A parameter with this name has already been added to the Parameters dictionary."
Private Type TSqlBuilder
QueryBody As String
QueryFooter As String
End Type
Private mobjParameters As Object
Private mobjPredicates As Collection
Private this As TSqlBuilder
' =============================================================================
' CONSTRUCTOR / DESTRUCTOR
' =============================================================================
Private Sub Class_Initialize()
Set mobjParameters = CreateObject("Scripting.Dictionary")
Set mobjPredicates = New Collection
End Sub
' =============================================================================
' PROPERTIES
' =============================================================================
'#Description("Gets or sets the query statement (SELECT, INSERT, UPDATE, DELETE), exclusive of any predicates.")
Public Property Get QueryBody() As String
QueryBody = this.QueryBody
End Property
Public Property Let QueryBody(ByVal Value As String)
this.QueryBody = Value
End Property
'#Description("Gets or sets post-predicate query statements (e.g., GROUP BY, ORDER BY).")
Public Property Get QueryFooter() As String
QueryFooter = this.QueryFooter
End Property
Public Property Let QueryFooter(ByVal Value As String)
this.QueryFooter = Value
End Property
' =============================================================================
' PUBLIC METHODS
' =============================================================================
'#Description("Maps a boolean parameter and its value to the query builder.")
'#Param("strName: The parameter's name.")
'#Param("blnValue: The parameter's value.")
Public Sub AddBooleanParameter(ByVal strName As String, ByVal blnValue As Boolean)
If mobjParameters.Exists(strName) Then
Err.Raise mlngErrorNumber, mstrClassName & ".AddBooleanParameter", mstrParameterExistsErrorMessage
Else
mobjParameters.Add strName, CStr(blnValue)
End If
End Sub
' =============================================================================
'#Description("Maps a currency parameter and its value to the query builder.")
'#Param("strName: The parameter's name.")
'#Param("curValue: The parameter's value.")
Public Sub AddCurrencyParameter(ByVal strName As String, ByVal curValue As Currency)
If mobjParameters.Exists(strName) Then
Err.Raise mlngErrorNumber, mstrClassName & ".AddCurrencyParameter", mstrParameterExistsErrorMessage
Else
mobjParameters.Add strName, CStr(curValue)
End If
End Sub
' =============================================================================
'#Description("Maps a date parameter and its value to the query builder.")
'#Param("strName: The parameter's name.")
'#Param("dtmValue: The parameter's value.")
Public Sub AddDateParameter(ByVal strName As String, ByVal dtmValue As Date)
If mobjParameters.Exists(strName) Then
Err.Raise mlngErrorNumber, mstrClassName & ".AddDateParameter", mstrParameterExistsErrorMessage
Else
mobjParameters.Add strName, "#" & CStr(dtmValue) & "#"
End If
End Sub
' =============================================================================
'#Description("Maps a long parameter and its value to the query builder.")
'#Param("strName: The parameter's name.")
'#Param("lngValue: The parameter's value.")
Public Sub AddLongParameter(ByVal strName As String, ByVal lngValue As Long)
If mobjParameters.Exists(strName) Then
Err.Raise mlngErrorNumber, mstrClassName & ".AddNumericParameter", mstrParameterExistsErrorMessage
Else
mobjParameters.Add strName, CStr(lngValue)
End If
End Sub
' =============================================================================
'#Description("Adds a predicate to the query's WHERE criteria.")
'#Param("strPredicate: The predicate text to be added.")
Public Sub AddPredicate(ByVal strPredicate As String)
mobjPredicates.Add "(" & strPredicate & ")"
End Sub
' =============================================================================
'#Description("Maps a string parameter and its value to the query builder.")
'#Param("strName: The parameter's name.")
'#Param("strValue: The parameter's value.")
Public Sub AddStringParameter(ByVal strName As String, ByVal strValue As String)
If mobjParameters.Exists(strName) Then
Err.Raise mlngErrorNumber, mstrClassName & ".AddStringParameter", mstrParameterExistsErrorMessage
Else
mobjParameters.Add strName, "'" & strValue & "'"
End If
End Sub
' =============================================================================
'#Description("Parses the query, its predicates, and any parameter values, and outputs an SQL statement.")
'#Returns("A string containing the parsed query.")
Public Function ToString() As String
Dim strPredicatesWithValues As String
Const strErrorSource As String = "QueryBuilder.ToString"
If this.QueryBody = vbNullString Then
Err.Raise mlngErrorNumber, strErrorSource, "No query body is currently defined. Unable to build valid SQL."
End If
ToString = this.QueryBody
strPredicatesWithValues = ReplaceParametersWithValues(GetPredicatesText)
EnsureParametersHaveValues strPredicatesWithValues
If Not strPredicatesWithValues = vbNullString Then
ToString = ToString & " " & strPredicatesWithValues
End If
If Not this.QueryFooter = vbNullString Then
ToString = ToString & " " & this.QueryFooter & ";"
End If
End Function
' =============================================================================
' PRIVATE METHODS
' =============================================================================
'#Description("Ensures that all parameters defined in the query have been provided a value.")
'#Param("strQueryText: The query text to verify.")
Private Sub EnsureParametersHaveValues(ByVal strQueryText As String)
Dim strUnmatchedParameter As String
Dim lngMatchedPoisition As Long
Dim lngWordEndPosition As Long
Const strProcedureName As String = "EnsureParametersHaveValues"
lngMatchedPoisition = InStr(1, strQueryText, "#", vbTextCompare)
If lngMatchedPoisition <> 0 Then
lngWordEndPosition = InStr(lngMatchedPoisition, strQueryText, Space$(1), vbTextCompare)
strUnmatchedParameter = Mid$(strQueryText, lngMatchedPoisition, lngWordEndPosition - lngMatchedPoisition)
End If
If Not strUnmatchedParameter = vbNullString Then
Err.Raise mlngErrorNumber, mstrClassName & "." & strProcedureName, "Parameter " & strUnmatchedParameter & " has not been provided a value."
End If
End Sub
' =============================================================================
'#Description("Combines each predicate in the predicates collection into a single string statement.")
'#Returns("A string containing the text of all predicates added to the query builder.")
Private Function GetPredicatesText() As String
Dim strPredicates As String
Dim vntPredicate As Variant
If mobjPredicates.Count > 0 Then
strPredicates = "WHERE 1 = 1"
For Each vntPredicate In mobjPredicates
strPredicates = strPredicates & " AND " & CStr(vntPredicate)
Next vntPredicate
End If
GetPredicatesText = strPredicates
End Function
' =============================================================================
'#Description("Replaces parameters in the predicates statements with their provided values.")
'#Param("strPredicates: The text of the query's predicates.")
'#Returns("A string containing the predicates text with its parameters replaces by their provided values.")
Private Function ReplaceParametersWithValues(ByVal strPredicates As String) As String
Dim vntKey As Variant
Dim strParameterName As String
Dim strParameterValue As String
Dim strPredicatesWithValues As String
Const strProcedureName As String = "ReplaceParametersWithValues"
strPredicatesWithValues = strPredicates
For Each vntKey In mobjParameters.Keys
strParameterName = CStr(vntKey)
strParameterValue = CStr(mobjParameters(vntKey))
If InStr(1, strPredicatesWithValues, "#" & strParameterName, vbTextCompare) = 0 Then
Err.Raise mlngErrorNumber, mstrClassName & "." & strProcedureName, "Parameter " & strParameterName & " was not found in the query."
Else
strPredicatesWithValues = Replace(strPredicatesWithValues, "#" & strParameterName, strParameterValue, 1, -1, vbTextCompare)
End If
Next vntKey
ReplaceParametersWithValues = strPredicatesWithValues
End Function
' =============================================================================
I have one method
Public CurrentFileNameNoExtension As String
Public Sub importexcelfile()
CurrentFileNameNoExtension ="Filename"
'do something
End Sub
I want to use CurrentFileNameNoExtension value in onEnter event of the dropdown list(cmvalues) event. That Value use in sql query. My code is
Private Sub cmvalues_Enter()
Dim qstng As String
qstng = CurrentFileNameNoExtension
Me.cmvalues.RowSourceType = "Table/Query"
Me.cmvalues.RowSource = "Select F1 from " & qstng & " WHERE F1 <> 'Control Model';"
End Sub
But qstng value is empty. it is not giving the value in the importexcelfile() function.
EDIT: As I've just noticed, thanks to #simoco, that this is indeed for a userform, there are actually a couple of things to pull this off. One is using globals, which is quite tricky, and another is to use a function to get the string you want.
Function CurrentFileNameNoExtension() As String
'Do some FSO or GetOpenFileName here.
CurrentFileNameNoExtension = "Filename"
End Sub
Private Sub cmvalues_Enter()
qstng = CurrentFileNameNoExtension
Me.cmvalues.RowSourceType = "Table/Query"
Me.cmvalues.RowSource = "Select F1 from " & strFileName & " WHERE F1 <> 'Control Model';"
End Sub
There is not much of an issue using the code you have, really. You just have to make sure that the first sub is called before the second one so that cmvalues_Enter has a valid string to process.
Place this function under Microsoft Access Class Objects Form control,Where cmvalues dropdown exists
Public CurrentFileNameNoExtension As String
Public Sub importexcelfile()
CurrentFileNameNoExtension ="Filename"
'do something
End Sub
I have created this function GetSubName that I need to return the name that is saves from a pull down box. It does this just fine as the dialog boxes I have used shows that it sets the variable correctly. The problem is that when the SQL below runs in a query I get the error: "Undefined function 'GetSubName' in expression." I am new to VBA so any help would be much appreciated.
Here is the code:
Option Compare Database
Option Explicit
Private stSubName As String
Private Sub Command2_Click()
On Error GoTo Err_Command2_Click
Dim stDocName As String
Dim stSubName As String
SubcontractorCombo.SetFocus
stSubName = SubcontractorCombo.SelText
'Confirm that stSubName variable is holding correct value'
MsgBox "Name of Subcontractor Selected is " & stSubName
SetSubName stSubName
GetSubName
DoCmd.Close
stDocName = "Summary Asphalt Production for Subcontractor"
DoCmd.OpenQuery stDocName
Exit_Command2_Click:
Exit Sub
Err_Command2_Click:
MsgBox Err.Description
Resume Exit_Command2_Click
End Sub
Public Sub SetSubName(Value As String)
'Set the module variable to be the value passed in from externally'
stSubName = Value
End Sub
Public Function GetSubName() As String
'Returns the value of the module variable'
GetSubName = stSubName
'MsgBox "GetSubName Variable is " & stSubName'
End Function
And here is my SQL from inside of Access 2007:
SELECT DISTINCTROW Subs.Subcontractor, Counties.County, Projects.ContractID,
Sum(Project_Items.USTons) AS SumOfUSTons, Projects.PlanQuantity,
Max(Project_Items.EstDate) AS MaxOfEstDate, Project_Items.Sub
FROM Counties INNER JOIN (Subs INNER JOIN (Projects INNER JOIN Project_Items ON
Projects.ContractID = Project_Items.ProjectID) ON Subs.VendID = Project_Items.Sub) ON
Counties.ID = Project_Items.County
WHERE (((Projects.Completed)<>True) AND ((Subs.Subcontractor)=GetSubName()))
GROUP BY Subs.Subcontractor, Counties.County, Projects.ContractID,
Projects.PlanQuantity, Project_Items.Sub;
The reason the functions are not recognized is that you haven't fully specified the name. A public function in a form module needs to be specified with the form name:
Forms!MyForm.GetSubName()
But this is the wrong approach, and your code is way too convoluted. You can access the value of the combo box in your query directly:
Forms!MyForm!SubcontractorCombo
Now, the fact that you're using .SelText suggests to me either that you're doing something very very tricky, or you have your combo box set up wrong. Combo boxes can have a found field and a display value, such that a list of employees might display the employee LastName/FirstName while the combo box actually has as its bound field the EmployeeID.
If your combo box has a hidden bound field, but you want the displayed value, you don't need to use .SelText -- just use the appropriate .Column() of the combo box:
Forms!MyForm!SubcontractorCombo.Column(1)
(the column count is zero-based, so the hidden column would be column 0, assuming it's the first column that is hidden)
Also, there's an issue that if the user selects PART of the text in the combo box, you'd have an incomplete match, so you really don't want to use .SelText at all.
So, the WHERE clause of your SQL would end up being this (assuming I've diagnosed everything correctly):
WHERE Projects.Completed<>True
AND Subs.Subcontractor=Forms!MyForm!SubcontractorCombo.Column(1)
...and you can lose all of the marked code:
Option Compare Database
Option Explicit
<strike>Private stSubName As String</strike>
Private Sub Command2_Click()
On Error GoTo Err_Command2_Click
Dim stDocName As String
Dim stSubName As String
SubcontractorCombo.SetFocus
<strike>stSubName = SubcontractorCombo.SelText</strike>
'Confirm that stSubName variable is holding correct value'
<strike>MsgBox "Name of Subcontractor Selected is " & stSubName</strike>
<strike>SetSubName stSubName</strike>
<strike>GetSubName</strike>
DoCmd.Close
stDocName = "Summary Asphalt Production for Subcontractor"
DoCmd.OpenQuery stDocName
Exit_Command2_Click:
Exit Sub
Err_Command2_Click:
MsgBox Err.Description
Resume Exit_Command2_Click
End Sub
<strike>Public Sub SetSubName(Value As String)
'Set the module variable to be the value passed in from externally'
stSubName = Value
End Sub</strike>
<strike>Public Function GetSubName() As String
'Returns the value of the module variable'
GetSubName = stSubName
'MsgBox "GetSubName Variable is " & stSubName'
End Function</strike>
Would an alternative approach work?
Create a table (SubNameTable) with one field: SubName.
Add one record to it.
Then change your Sub to this:
Public Sub SetSubName(Value As String)
CurrentDb.Execute ("Update SubNameTable Set SubName = '" & Value & "'")
End Sub
Now you can Remove the function and modular variable.
Then, alter your SQL as such:
SELECT
*BlahBlahBlahFields*
FROM
*BlahBlahBlahTables*
INNER JOIN Subs
INNER JOIN SubNameTable ON Subs.SubContractor = SubNameTable.SubName
WHERE (((Projects.Completed)<>True)
GROUP BY
Subs.Subcontractor,
Counties.County,
Projects.ContractID,
Projects.PlanQuantity,
Project_Items.Sub
Not that this is the greatest solution, but should solve some future problems of trying to reference a function in a form. You could use a parameter on your query and set its value to the combo box.
You should put the public functions in a Module. I called this one Module2
Option Compare Database
Option Explicit
Private stSubName As String
Public Sub SetSubName(Value As String)
'Set the module variable to be the value passed in from externally'
stSubName = Value
End Sub
Public Function GetSubName() As String
'Returns the value of the module variable'
GetSubName = stSubName
'MsgBox "GetSubName Variable is " & stSubName'
End Function
Your form will reference the functions in the module:
Option Compare Database
Option Explicit
Private stSubName As String
Private Sub Command2_Click()
On Error GoTo Err_Command2_Click
Dim stDocName As String
Dim stSubName As String
SubcontractorCombo.SetFocus
stSubName = SubcontractorCombo.SelText
'Confirm that stSubName variable is holding correct value'
MsgBox "Name of Subcontractor Selected is " & stSubName
Module2.SetSubName stSubName
Module2.GetSubName
DoCmd.Close
stDocName = "Summary Asphalt Production for Subcontractor"
DoCmd.OpenQuery stDocName
Exit_Command2_Click:
Exit Sub
Err_Command2_Click:
MsgBox Err.Description
Resume Exit_Command2_Click
End Sub
The query will be able to find the public function in the module.