If strFilter & "" <> "" Then
Me.TextstrWhere = Mid(strFilter, 5)
'Me.ServerFilter = Mid(strFilter, 5)
Else
' Me.ServerFilter = ""
Me.TextstrWhere = "ALL"
End If
Me.Requery
If strFilter & "" <> "" Then'---------------------------------------------------------------------------------------
' Procedure : ADOExecuteSP
' Date : 21.09.2011
' Last Change : 29.10.2012
' Purpose : Executes a Stored Procedure with optional parameters and single return value
' Parameters : Parameters: strSPName: Name of the stored procedure on the server
' strParamNameList : Comma-separated list of parameters for the SP
' strParamValueList: Comma-separated list of parameter values for the SP
' strParamSizeValueList: Comma-separated list of parameter sizes for the SP
' (empty values for default size). Example for
' 3 parameters with last one as nvarchar(MAX): ",,10000"
' Example : ADOExecuteSP "NameOfSP" , "@P1,@P2,@P3" , "V1,V2,V3"
' Returns : ADODB.Command (to read out the OUTPUT parameters)
' Returns the parameter in "@RETURN_VALUE" in class variable only if exists.
' THIS IS ALWAYS A LONG VALUE!
'---------------------------------------------------------------------------------------
'
Public Function ADOExecuteSP_OUTPUT(ByVal strSPName As String, _
Optional ByVal strParamNameList As String = "", _
Optional ByVal strParamValueList As String = "", _
Optional ByVal strParamSizeValueList As String = "", _
Optional ByVal strDelimiter As String = ",", _
Optional ByVal bolOutputRecordset As Boolean = False, _
Optional ByVal intLockType As ADODB.LockTypeEnum = adLockReadOnly, _
Optional ByVal intOpenMode As ADODB.CursorTypeEnum = adOpenForwardOnly, _
Optional ByVal bolFormRecordset As Boolean = False) As ADODB.Command
Dim cmdADO As ADODB.Command
Dim strParameterList() As String
Dim strValueList() As String
Dim strSizeValueList() As String
Dim i As Long
clsvar_strObjectError = "OK"
On Error GoTo ADOExecuteSP_Error
If Me.ADOOpenConnection = "OK" Then
Set cmdADO = New ADODB.Command
With cmdADO
.CommandText = strSPName
.CommandType = adCmdStoredProc
If Not bolFormRecordset Then
.ActiveConnection = clsvar_objADOConnection
Else
' Updatable form recordsets needs the Access OLEDB driver to be updatable
.ActiveConnection = CurrentProject.AccessConnection
End If
' Automatically load the parameters for the stored procedure
' into the parameters collection
.Parameters.Refresh
If Not strParamNameList = "" Then
strParameterList = Split(strParamNameList, strDelimiter)
End If
If Not strParamValueList = "" Then
strValueList = Split(strParamValueList, strDelimiter)
End If
If Not strParamSizeValueList = "" Then
strSizeValueList = Split(strParamSizeValueList, strDelimiter)
Else
If strParamNameList <> "" Then
ReDim strSizeValueList(UBound(strParameterList))
End If
End If
If Not strParamNameList = "" And _
Not strParamValueList = "" Then
If .Parameters.Count > 0 Then
' fill the parameters with values
For i = 0 To UBound(strParameterList)
If strParamSizeValueList <> "" And strSizeValueList(i) <> "" Then
.Parameters(Trim(strParameterList(i))).Size = Val(strSizeValueList(i))
End If
.Parameters(Trim(strParameterList(i))).Value = IIf(strValueList(i) = "NULL", Null, strValueList(i))
Next
Else
clsvar_strObjectError = "No Parameters"
End If
End If
.CommandTimeout = cCommandTimeout
If bolOutputRecordset Then
Set Me.rsADO = New ADODB.Recordset
With Me.rsADO
.CursorLocation = adUseClient
.CursorType = intOpenMode
.LockType = intLockType ' Updatable recordsets are only usable in VBA, not as form recordset
.Open cmdADO
End With
Else
.Execute clsvar_lngADORecordCount
End If
On Error Resume Next
clsvar_strLastSQL = .CommandText
' If an error occurs in the next line the return value will have a value of -1
clsvar_lngReturnValueSP = -1
clsvar_lngReturnValueSP = .Parameters("@RETURN_VALUE")
' @Return_Value is ALWAYS a LONG value!
' to read out the OUTPUT-values from the parameters collection
' return the command object.
' Calling sub must close the connection on its own!
Set ADOExecuteSP_OUTPUT = cmdADO
End With
End If
ADOExecuteSP_Exit:
' cmdADO is returned, so it must not be closed
Exit Function
ADOExecuteSP_Error:
Select Case Err.Number
Case Else
If Not clsvar_bolNoMsgBox Then ObjErr(clsvar_objADOConnection).fnErr "Class: " & cMODULENAME, "Function: ADOExecuteSP_OUTPUT"
Me.ADOCloseConnection
clsvar_strObjectError = "ERROR"
End Select
Resume ADOExecuteSP_Exit
End Function
Dim cmd As ADODB.Command
Set cmd = ADOExecuteSP_OUTPUT("NameOfSP" , "@strWhere" , strFilter, "64000", , True)
Set Me.Recordset = NameOfClassVariable.rsADO
Caution: If you want to have an updatable recordset for a form you are forced to use the SQLOLEDB driver in the connection object as forms do not produce updatable results if you use the SQLNCLI driver as usual. If your form do not need to be updatable you can use the SQLNCLI driver.if that would not be a complete filter string...I assume you are concerned about the sql injection, first its an in-house db, not accessible outside the network that we have to be concerned about malicious coders, secondly just wondering how can something bad be inserted here (like truncate, delete etc), if its being added after the where clause?
ALTER PROCEDURE proc_FilterOrientNotes_Test @strWhere AS nvarchar(4000)
AS
BEGIN
-- SET NOCOUNT ON added to prevent extra result sets from
-- interfering with SELECT statements.
SET NOCOUNT ON;
INSERT INTO tblTestBigString (TextValue) VALUES (@strWhere);
SELECT 'X' AS LastName, 'Y' AS FirstName, 'Mr' AS Title
END
That inserts the parameter of strWhere into the test table to see if it is forwarded to SQL Server without cutting it. I used the proc name and parameter name of your form which has this as record source and uses the InputParamaters property to forward the control TextstrWhere to the procedure. I then changed your code like this:...
strFilter = strFilter & AdditionalFilter
Me.TextstrWhere = strFilter
Me.Requery
...
to see if the filter string (691 characters in my test) would be forwarded correctly and what a surprise: No problem. The table contained the complete string without any problem so this makes sure that there is no problem in the frontend's forwarding of the value in case of InputParameters.CREATE PROCEDURE [dbo].[proc_FilterOrientNotes_Test2] (@strWhere nvarchar(4000))
AS
BEGIN
declare @tmp nvarchar(4000)
declare @strWhere2 nvarchar(4000)
SET @tmp='SELECT (CASE WHEN Last_Orient_Note_Day IS NULL OR Last_Orient_Note_Day < GETDATE() - 60
THEN ''T'' ELSE '''' END) AS Red,
ORN.ID, O.EmployeeID,
O.FacilityID, O.Active, ORN.Note, COALESCE (ORN.Day, O.DateEntered)
AS Day, ORN.Initial, O.ID AS OrientationID, O.DateEntered, O.Initial AS OrientationInitial,
O.Traveler, EDT.TovInfoLastDay AS LastDay, O.DueDate, ORN.Mailing,
O.DueDateInitial, EDT.Last_Orient_Note_Day, EMP.AvailibilityPDays,
EMP.AvailibilityPShifts, EMP.City, EMP.LastName, EMP.FirstName, EMP.Title,
FAC.Name AS FacilityName, vwOLN.LastNoteID, EDT.TovInfoFacility1 AS LastFacility,
EMP.Degree
FROM dbo.Orientations AS O INNER JOIN
dbo.Employeestbl AS EMP ON O.EmployeeID = EMP.ID INNER JOIN
dbo.Facilitiestbl AS FAC ON O.FacilityID = FAC.ID LEFT OUTER JOIN
dbo.view_OrientationLastNote AS vwOLN ON O.ID = vwOLN.OrientationID LEFT OUTER JOIN
dbo.EmployeesDocsTov AS EDT ON O.EmployeeID = EDT.EmployeeID LEFT OUTER JOIN
dbo.OrientationNotes AS ORN ON O.ID = ORN.OrientationID';
IF @strWhere IS NOT NULL AND @strwhere <> 'ALL' and @strwhere <> 'Long'
set @tmp = @tmp + ' WHERE ' + @strWhere ;
IF @strWhere IS NULL
set @tmp = @tmp + ' WHERE O.EmployeeID = 3';
IF @strWhere = 'Long'
begin
set @strWhere2 = (select [value] from ProgrammingSettings where [Code] = 'FilterOrientationNotesSql');
set @tmp = @tmp + ' WHERE ' + @strWhere2;
end
--set @tmp = @tmp + ' ORDER BY O.DateEntered DESC, ORN.ID desc';
EXECUTE sp_executesql @tmp;
END
exec sp_executesql N'EXEC "dbo"."proc_FilterOrientNotes_Test2" @P1 ',N'@P1 nvarchar(500)',N' O.EmployeeID in (SELECT EmployeesID FROM
EmployeesUnitstbl WHERE unit IN (''RN'')) AND ORN.Day >= ''01/01/2006'' AND O.DateEntered >= ''01/01/2006'''
“ strFilter = AdditionalFilter(strFilter)
strFilter = " and " & strFilter & " and " & strFilter & " " & strFilter
Me.TextstrWhere = strFilter
Me.Requery
exec sp_executesql N' EXEC "dbo"."proc_FilterOrientNotes_Test" @P1 ',N'@P1 nvarchar(2000)',N' O.EmployeeID in (SELECT EmployeesID FROM EmployeesUnitstbl WHERE unit IN (''U2'',''U5'')) OR O.EmployeeID in (SELECT EmployeesID FROM EmployeesUnitstbl WHERE unit IN (''U1'',''U3'',''U4'')) and O.FacilityID = 1 And O.Active = 1 And EDT.TovInfoLastDay >= ''10.01.2013'' And EDT.TovInfoLastDay <= ''10.02.14'' And O.DueDate >= ''10.03.2013'' And O.DueDate <= ''10.05.13'' And OrientationID is null And Degree = ''BSN'' O.EmployeeID in (SELECT EmployeesID FROM EmployeesUnitstbl WHERE unit IN (''U2'',''U5'')) OR O.EmployeeID in (SELECT EmployeesID FROM EmployeesUnitstbl WHERE unit IN (''U1'',''U3'',''U4'')) and O.FacilityID = 1 And O.Active = 1 And EDT.TovInfoLastDay >= ''10.01.2013'' And EDT.TovInfoLastDay <= ''10.02.14'' And O.DueDate >= ''10.03.2013'' And O.DueDate <= ''10.05.13'' And OrientationID is null And Degree = ''BSN'' O.EmployeeID in (SELECT EmployeesID FROM EmployeesUnitstbl WHERE unit IN (''U2'',''U5'')) OR O.EmployeeID in (SELECT EmployeesID FROM EmployeesUnitstbl WHERE unit IN (''U1'',''U3'',''U4'')) and O.FacilityID = 1 And O.Active = 1 And EDT.TovInfoLastDay >= ''10.01.2013'' And EDT.TovInfoLastDay <= ''10.02.14'' And O.DueDate >= ''10.03.2013'' And O.DueDate <= ''10.05.13'' And OrientationID is null And Degree = ''BSN'' O.EmployeeID in (SELECT EmployeesID FROM EmployeesUnitstbl WHERE unit IN (''U2'',''U5'')) OR O.EmployeeID in (SELECT EmployeesID FROM EmployeesUnitstbl WHERE unit IN (''U1'',''U3'',''U4'')) and O.FacilityID = 1 And O.Active = 1 And EDT.TovInfoLastDay >= ''10.01.2013'' And EDT.TovInfoLastDay <= ''10.02.14'' And O.DueDate >= ''10.03.2013'' And O.DueDate <= ''10.05.13'' And OrientationID is null And Degree = ''BSN'' O.EmployeeID in (SELECT EmployeesID FROM EmployeesUnitstbl WHERE unit IN (''U2'',''U5'')) OR O.EmployeeID in (SELECT EmployeesID FROM EmployeesUnitstbl WHERE unit IN (''U1'',''U3'',''U4'')) and O.FacilityID = 1 And O.Active = 1 And EDT.TovInfoLastDay >= ''10.01.2013'' And EDT.TovInfoLastDay <= ''10.02.14'' And O.DueDate >= ''10.03.2013'' And O.DueDate <= ''10.05.13'' And OrientationID is null And Degree = ''BSN'''
...N'@P1 nvarchar(2000)'...
to match the length of the string. It does the same with your Access as in your case the profiler shows:...N'@P1 nvarchar(851)'...
But what you can also see is that it seems to be interrupted with some characters which seems not to belong to the string:01/¿¿¿
(that's the end of your profiler string)