Current Record Source

  • Thread starter Thread starter NEWER USER
  • Start date Start date
N

NEWER USER

I have the following Function in a module and using on a toolbar. It works
well on the open form which the toolbar is assigned to. The current Record
Source of my form is qryAll. I want to use this Function on several other
forms each with a different Record Source. How do I go about using a
variable as the Record Source changes? I don't want to create a separate
toolbar for every form. Any help appreciated.

Function QTagProduct()
On Error GoTo QTagProduct_Err

Dim strWhere As String
Dim strMsg As String

With CodeContextObject
strWhere = "WHERE " & .Filter
End With
strMsg = "FILTERED records will be tagged."

If (MsgBox(strMsg, 273, "Warning") <> 1) Then
'Tag Current filtered Records
DoCmd.CancelEvent
Exit Function
End If

DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE qryAll " & _
"SET qryAll.T = '-1'" & strWhere
DoCmd.Requery
DoCmd.SetWarnings True

QTagProduct_Exit:
Exit Function

QTagProduct_Err:
MsgBox Err.Description
Resume QTagProduct_Exit

End Function
 
NEWER USER -

You can get the current form (see Screen.ActiveForm in help) and put it into
a form variable, then you can get the recordsource for that form. Something
like this:

Dim frmCurrForm as Form
Dim strSQL as String

Set frmCurrForm = Screen.ActiveForm 'Gets the current form

strSQL = frmCurrForm.RecordSource 'Get the recordsource for the current
form

Then you can make changes as you want to the strSQL, and update the
frmCurrForm.RecordSource with that.
 
I updated the Function using your suggestions, but must have done something
wrong as I am getting an error message stating "Cannot find input table or
query 'strSQL'"


Function QFillPSyn()
On Error GoTo QFillPSyn_Err
Dim frmCurrForm As Form
Dim strSQL As String
Dim strWhere As String
Dim strMsg As String

Set frmCurrForm = Screen.ActiveForm 'Gets the current form
strSQL = frmCurrForm.RecordSource 'Get the recordsource for the
current Form

With CodeContextObject
strWhere = "WHERE " & .Filter
End With

strMsg = "Order values for FILTERED records" & vbCrLf & _
"will be updated to Per Car Quantity."
If (MsgBox(strMsg, 273, "Warning") <> 1) Then
'Update Order values for current records on form
DoCmd.CancelEvent
Exit Function
End If

DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE strSQL " & _
"SET strSQL.Order = [Per Car]" & strWhere
DoCmd.Requery
DoCmd.SetWarnings True

QFillPSyn_Exit:
Exit Function

QFillPSyn_Err:
MsgBox Err.Description
Resume QFillPSyn_Exit

End Function
 
Newer User -

strSQL is not a table or query name. It is the SQL statement for the
current recordsource. You will need to parse out the table name from this
strSQL. Something like this:

Dim intPosition As Integer
Dim TblQryName As String

intPosition = InStr(1, strSQL, "FROM", vbTextCompare) + 4 'Add 4 for the
length of "FROM "
TblQryName = Right(strSQL, Len(strSQL) - intPosition)
intPosition = InStr(1, TblQryName, " ", vbTextCompare) - 1 'Find first
space after name, and back up one
TblQryName = Left(TblQryName, intPosition)

Once you have the TblQryName, you will need to change your DoCmd statement
to use this - but not within the quotes. Like this:

DoCmd.RunSQL "UPDATE " & TblQryName & _
"SET " & TblQryName & ".Order = [Per Car]" & strWhere

Step through this in debug mode in case I missed a space or digit...
Let us know!
--
Daryl S


NEWER USER said:
I updated the Function using your suggestions, but must have done something
wrong as I am getting an error message stating "Cannot find input table or
query 'strSQL'"


Function QFillPSyn()
On Error GoTo QFillPSyn_Err
Dim frmCurrForm As Form
Dim strSQL As String
Dim strWhere As String
Dim strMsg As String

Set frmCurrForm = Screen.ActiveForm 'Gets the current form
strSQL = frmCurrForm.RecordSource 'Get the recordsource for the
current Form

With CodeContextObject
strWhere = "WHERE " & .Filter
End With

strMsg = "Order values for FILTERED records" & vbCrLf & _
"will be updated to Per Car Quantity."
If (MsgBox(strMsg, 273, "Warning") <> 1) Then
'Update Order values for current records on form
DoCmd.CancelEvent
Exit Function
End If

DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE strSQL " & _
"SET strSQL.Order = [Per Car]" & strWhere
DoCmd.Requery
DoCmd.SetWarnings True

QFillPSyn_Exit:
Exit Function

QFillPSyn_Err:
MsgBox Err.Description
Resume QFillPSyn_Exit

End Function

Daryl S said:
NEWER USER -

You can get the current form (see Screen.ActiveForm in help) and put it into
a form variable, then you can get the recordsource for that form. Something
like this:

Dim frmCurrForm as Form
Dim strSQL as String

Set frmCurrForm = Screen.ActiveForm 'Gets the current form

strSQL = frmCurrForm.RecordSource 'Get the recordsource for the current
form

Then you can make changes as you want to the strSQL, and update the
frmCurrForm.RecordSource with that.
Click to expand...
Click to expand...
 
After updating more, I am getting an error Invalid procedure call or
argumnet. I appreciate all the help.

Function QFillPSyn()
On Error GoTo QFillPSyn_Err
Dim strWhere As String
Dim strMsg As String
Dim intPosition As Integer
Dim TblQryName As String
Dim strSQL As String
Dim frmCurrForm As Form

Set frmCurrForm = Screen.ActiveForm 'Gets the current form
strSQL = frmCurrForm.RecordSource 'Get the recordsource for the
current Form
intPosition = InStr(1, strSQL, "FROM", vbTextCompare) + 4 'Add 4 for
the length of "FROM "
TblQryName = right(strSQL, Len(strSQL) - intPosition)
intPosition = InStr(1, TblQryName, " ", vbTextCompare) - 1 'Find first
space after name, and back up one
TblQryName = Left(TblQryName, intPosition)

With CodeContextObject
strWhere = "WHERE " & .Filter
End With

strMsg = "Order values for FILTERED records" & vbCrLf & _
"will be updated to Per Car Quantity."
If (MsgBox(strMsg, 273, "Warning") <> 1) Then
'Update Order values for current records on form
DoCmd.CancelEvent
Exit Function
End If

DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE " & TblQryName & _
"SET " & TblQryName & ".Order = [Per Car]" & strWhere
DoCmd.Requery
DoCmd.SetWarnings True

QFillPSyn_Exit:
Exit Function

QFillPSyn_Err:
MsgBox Err.Description
Resume QFillPSyn_Exit

End Function

Daryl S said:
Newer User -

strSQL is not a table or query name. It is the SQL statement for the
current recordsource. You will need to parse out the table name from this
strSQL. Something like this:

Dim intPosition As Integer
Dim TblQryName As String

intPosition = InStr(1, strSQL, "FROM", vbTextCompare) + 4 'Add 4 for the
length of "FROM "
TblQryName = Right(strSQL, Len(strSQL) - intPosition)
intPosition = InStr(1, TblQryName, " ", vbTextCompare) - 1 'Find first
space after name, and back up one
TblQryName = Left(TblQryName, intPosition)

Once you have the TblQryName, you will need to change your DoCmd statement
to use this - but not within the quotes. Like this:

DoCmd.RunSQL "UPDATE " & TblQryName & _
"SET " & TblQryName & ".Order = [Per Car]" & strWhere

Step through this in debug mode in case I missed a space or digit...
Let us know!
--
Daryl S


NEWER USER said:
I updated the Function using your suggestions, but must have done something
wrong as I am getting an error message stating "Cannot find input table or
query 'strSQL'"


Function QFillPSyn()
On Error GoTo QFillPSyn_Err
Dim frmCurrForm As Form
Dim strSQL As String
Dim strWhere As String
Dim strMsg As String

Set frmCurrForm = Screen.ActiveForm 'Gets the current form
strSQL = frmCurrForm.RecordSource 'Get the recordsource for the
current Form

With CodeContextObject
strWhere = "WHERE " & .Filter
End With

strMsg = "Order values for FILTERED records" & vbCrLf & _
"will be updated to Per Car Quantity."
If (MsgBox(strMsg, 273, "Warning") <> 1) Then
'Update Order values for current records on form
DoCmd.CancelEvent
Exit Function
End If

DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE strSQL " & _
"SET strSQL.Order = [Per Car]" & strWhere
DoCmd.Requery
DoCmd.SetWarnings True

QFillPSyn_Exit:
Exit Function

QFillPSyn_Err:
MsgBox Err.Description
Resume QFillPSyn_Exit

End Function

Daryl S said:
NEWER USER -

You can get the current form (see Screen.ActiveForm in help) and put it into
a form variable, then you can get the recordsource for that form. Something
like this:

Dim frmCurrForm as Form
Dim strSQL as String

Set frmCurrForm = Screen.ActiveForm 'Gets the current form

strSQL = frmCurrForm.RecordSource 'Get the recordsource for the current
form

Then you can make changes as you want to the strSQL, and update the
frmCurrForm.RecordSource with that.

--
Daryl S


:

I have the following Function in a module and using on a toolbar. It works
well on the open form which the toolbar is assigned to. The current Record
Source of my form is qryAll. I want to use this Function on several other
forms each with a different Record Source. How do I go about using a
variable as the Record Source changes? I don't want to create a separate
toolbar for every form. Any help appreciated.

Function QTagProduct()
On Error GoTo QTagProduct_Err

Dim strWhere As String
Dim strMsg As String

With CodeContextObject
strWhere = "WHERE " & .Filter
End With
strMsg = "FILTERED records will be tagged."

If (MsgBox(strMsg, 273, "Warning") <> 1) Then
'Tag Current filtered Records
DoCmd.CancelEvent
Exit Function
End If

DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE qryAll " & _
"SET qryAll.T = '-1'" & strWhere
DoCmd.Requery
DoCmd.SetWarnings True

QTagProduct_Exit:
Exit Function

QTagProduct_Err:
MsgBox Err.Description
Resume QTagProduct_Exit

End Function
Click to expand...
Click to expand...
Click to expand...
 
OK, where is the error message coming from? What does your calling code look
like? Normally a function will return a value, but you don't have your
function set up to do that. Did you want to return a value from the
function? If the error is not in the calling code, is it in the function
code?

Did you compile the code? If the compile is OK, then step through the code
(put a breakpoint on the first executable line and run as normal).

One thought - if your table or query name in the recordsource has square
brackets around it (usually due to a space or special character in the table
or query name), then you will want to find the end of the TblQryName by
searching for the right square bracket instead of a space.
--
Daryl S


NEWER USER said:
After updating more, I am getting an error Invalid procedure call or
argumnet. I appreciate all the help.

Function QFillPSyn()
On Error GoTo QFillPSyn_Err
Dim strWhere As String
Dim strMsg As String
Dim intPosition As Integer
Dim TblQryName As String
Dim strSQL As String
Dim frmCurrForm As Form

Set frmCurrForm = Screen.ActiveForm 'Gets the current form
strSQL = frmCurrForm.RecordSource 'Get the recordsource for the
current Form
intPosition = InStr(1, strSQL, "FROM", vbTextCompare) + 4 'Add 4 for
the length of "FROM "
TblQryName = right(strSQL, Len(strSQL) - intPosition)
intPosition = InStr(1, TblQryName, " ", vbTextCompare) - 1 'Find first
space after name, and back up one
TblQryName = Left(TblQryName, intPosition)

With CodeContextObject
strWhere = "WHERE " & .Filter
End With

strMsg = "Order values for FILTERED records" & vbCrLf & _
"will be updated to Per Car Quantity."
If (MsgBox(strMsg, 273, "Warning") <> 1) Then
'Update Order values for current records on form
DoCmd.CancelEvent
Exit Function
End If

DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE " & TblQryName & _
"SET " & TblQryName & ".Order = [Per Car]" & strWhere
DoCmd.Requery
DoCmd.SetWarnings True

QFillPSyn_Exit:
Exit Function

QFillPSyn_Err:
MsgBox Err.Description
Resume QFillPSyn_Exit

End Function

Daryl S said:
Newer User -

strSQL is not a table or query name. It is the SQL statement for the
current recordsource. You will need to parse out the table name from this
strSQL. Something like this:

Dim intPosition As Integer
Dim TblQryName As String

intPosition = InStr(1, strSQL, "FROM", vbTextCompare) + 4 'Add 4 for the
length of "FROM "
TblQryName = Right(strSQL, Len(strSQL) - intPosition)
intPosition = InStr(1, TblQryName, " ", vbTextCompare) - 1 'Find first
space after name, and back up one
TblQryName = Left(TblQryName, intPosition)

Once you have the TblQryName, you will need to change your DoCmd statement
to use this - but not within the quotes. Like this:

DoCmd.RunSQL "UPDATE " & TblQryName & _
"SET " & TblQryName & ".Order = [Per Car]" & strWhere

Step through this in debug mode in case I missed a space or digit...
Let us know!
--
Daryl S


NEWER USER said:
I updated the Function using your suggestions, but must have done something
wrong as I am getting an error message stating "Cannot find input table or
query 'strSQL'"


Function QFillPSyn()
On Error GoTo QFillPSyn_Err
Dim frmCurrForm As Form
Dim strSQL As String
Dim strWhere As String
Dim strMsg As String

Set frmCurrForm = Screen.ActiveForm 'Gets the current form
strSQL = frmCurrForm.RecordSource 'Get the recordsource for the
current Form

With CodeContextObject
strWhere = "WHERE " & .Filter
End With

strMsg = "Order values for FILTERED records" & vbCrLf & _
"will be updated to Per Car Quantity."
If (MsgBox(strMsg, 273, "Warning") <> 1) Then
'Update Order values for current records on form
DoCmd.CancelEvent
Exit Function
End If

DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE strSQL " & _
"SET strSQL.Order = [Per Car]" & strWhere
DoCmd.Requery
DoCmd.SetWarnings True

QFillPSyn_Exit:
Exit Function

QFillPSyn_Err:
MsgBox Err.Description
Resume QFillPSyn_Exit

End Function

:

NEWER USER -

You can get the current form (see Screen.ActiveForm in help) and put it into
a form variable, then you can get the recordsource for that form. Something
like this:

Dim frmCurrForm as Form
Dim strSQL as String

Set frmCurrForm = Screen.ActiveForm 'Gets the current form

strSQL = frmCurrForm.RecordSource 'Get the recordsource for the current
form

Then you can make changes as you want to the strSQL, and update the
frmCurrForm.RecordSource with that.

--
Daryl S


:

I have the following Function in a module and using on a toolbar. It works
well on the open form which the toolbar is assigned to. The current Record
Source of my form is qryAll. I want to use this Function on several other
forms each with a different Record Source. How do I go about using a
variable as the Record Source changes? I don't want to create a separate
toolbar for every form. Any help appreciated.

Function QTagProduct()
On Error GoTo QTagProduct_Err

Dim strWhere As String
Dim strMsg As String

With CodeContextObject
strWhere = "WHERE " & .Filter
End With
strMsg = "FILTERED records will be tagged."

If (MsgBox(strMsg, 273, "Warning") <> 1) Then
'Tag Current filtered Records
DoCmd.CancelEvent
Exit Function
End If

DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE qryAll " & _
"SET qryAll.T = '-1'" & strWhere
DoCmd.Requery
DoCmd.SetWarnings True

QTagProduct_Exit:
Exit Function

QTagProduct_Err:
MsgBox Err.Description
Resume QTagProduct_Exit

End Function
Click to expand...
Click to expand...
Click to expand...
 
The line of code in question is (turns yellow)
TblQryName = Left(TblQryName, intPosition)

My function is called from the On Action property on the toolbar command.
Normally, I would put a command button on a form and run the code referencing
the qry or table name. But, I am viewing Datasheet View and need a way of
running the command, so I have the function assigned to the toolbar that is
visible when the form is open. I want this same toolbar on several forms
(Datasheet View)and have it look at the Active Form to pick up the query and
any filter that may be present at time I run the command on the toolbar.
Hope this makes sense to my madness.


Daryl S said:
OK, where is the error message coming from? What does your calling code look
like? Normally a function will return a value, but you don't have your
function set up to do that. Did you want to return a value from the
function? If the error is not in the calling code, is it in the function
code?

Did you compile the code? If the compile is OK, then step through the code
(put a breakpoint on the first executable line and run as normal).

One thought - if your table or query name in the recordsource has square
brackets around it (usually due to a space or special character in the table
or query name), then you will want to find the end of the TblQryName by
searching for the right square bracket instead of a space.
--
Daryl S


NEWER USER said:
After updating more, I am getting an error Invalid procedure call or
argumnet. I appreciate all the help.

Function QFillPSyn()
On Error GoTo QFillPSyn_Err
Dim strWhere As String
Dim strMsg As String
Dim intPosition As Integer
Dim TblQryName As String
Dim strSQL As String
Dim frmCurrForm As Form

Set frmCurrForm = Screen.ActiveForm 'Gets the current form
strSQL = frmCurrForm.RecordSource 'Get the recordsource for the
current Form
intPosition = InStr(1, strSQL, "FROM", vbTextCompare) + 4 'Add 4 for
the length of "FROM "
TblQryName = right(strSQL, Len(strSQL) - intPosition)
intPosition = InStr(1, TblQryName, " ", vbTextCompare) - 1 'Find first
space after name, and back up one
TblQryName = Left(TblQryName, intPosition)

With CodeContextObject
strWhere = "WHERE " & .Filter
End With

strMsg = "Order values for FILTERED records" & vbCrLf & _
"will be updated to Per Car Quantity."
If (MsgBox(strMsg, 273, "Warning") <> 1) Then
'Update Order values for current records on form
DoCmd.CancelEvent
Exit Function
End If

DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE " & TblQryName & _
"SET " & TblQryName & ".Order = [Per Car]" & strWhere
DoCmd.Requery
DoCmd.SetWarnings True

QFillPSyn_Exit:
Exit Function

QFillPSyn_Err:
MsgBox Err.Description
Resume QFillPSyn_Exit

End Function

Daryl S said:
Newer User -

strSQL is not a table or query name. It is the SQL statement for the
current recordsource. You will need to parse out the table name from this
strSQL. Something like this:

Dim intPosition As Integer
Dim TblQryName As String

intPosition = InStr(1, strSQL, "FROM", vbTextCompare) + 4 'Add 4 for the
length of "FROM "
TblQryName = Right(strSQL, Len(strSQL) - intPosition)
intPosition = InStr(1, TblQryName, " ", vbTextCompare) - 1 'Find first
space after name, and back up one
TblQryName = Left(TblQryName, intPosition)

Once you have the TblQryName, you will need to change your DoCmd statement
to use this - but not within the quotes. Like this:

DoCmd.RunSQL "UPDATE " & TblQryName & _
"SET " & TblQryName & ".Order = [Per Car]" & strWhere

Step through this in debug mode in case I missed a space or digit...
Let us know!
--
Daryl S


:

I updated the Function using your suggestions, but must have done something
wrong as I am getting an error message stating "Cannot find input table or
query 'strSQL'"


Function QFillPSyn()
On Error GoTo QFillPSyn_Err
Dim frmCurrForm As Form
Dim strSQL As String
Dim strWhere As String
Dim strMsg As String

Set frmCurrForm = Screen.ActiveForm 'Gets the current form
strSQL = frmCurrForm.RecordSource 'Get the recordsource for the
current Form

With CodeContextObject
strWhere = "WHERE " & .Filter
End With

strMsg = "Order values for FILTERED records" & vbCrLf & _
"will be updated to Per Car Quantity."
If (MsgBox(strMsg, 273, "Warning") <> 1) Then
'Update Order values for current records on form
DoCmd.CancelEvent
Exit Function
End If

DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE strSQL " & _
"SET strSQL.Order = [Per Car]" & strWhere
DoCmd.Requery
DoCmd.SetWarnings True

QFillPSyn_Exit:
Exit Function

QFillPSyn_Err:
MsgBox Err.Description
Resume QFillPSyn_Exit

End Function

:

NEWER USER -

You can get the current form (see Screen.ActiveForm in help) and put it into
a form variable, then you can get the recordsource for that form. Something
like this:

Dim frmCurrForm as Form
Dim strSQL as String

Set frmCurrForm = Screen.ActiveForm 'Gets the current form

strSQL = frmCurrForm.RecordSource 'Get the recordsource for the current
form

Then you can make changes as you want to the strSQL, and update the
frmCurrForm.RecordSource with that.

--
Daryl S


:

I have the following Function in a module and using on a toolbar. It works
well on the open form which the toolbar is assigned to. The current Record
Source of my form is qryAll. I want to use this Function on several other
forms each with a different Record Source. How do I go about using a
variable as the Record Source changes? I don't want to create a separate
toolbar for every form. Any help appreciated.

Function QTagProduct()
On Error GoTo QTagProduct_Err

Dim strWhere As String
Dim strMsg As String

With CodeContextObject
strWhere = "WHERE " & .Filter
End With
strMsg = "FILTERED records will be tagged."

If (MsgBox(strMsg, 273, "Warning") <> 1) Then
'Tag Current filtered Records
DoCmd.CancelEvent
Exit Function
End If

DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE qryAll " & _
"SET qryAll.T = '-1'" & strWhere
DoCmd.Requery
DoCmd.SetWarnings True

QTagProduct_Exit:
Exit Function

QTagProduct_Err:
MsgBox Err.Description
Resume QTagProduct_Exit

End Function
Click to expand...
Click to expand...
Click to expand...
 
Back
Top