Option Compare Database
Private NoForm As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''
'Code Written By: Charles Branham
'Date: 02/13/2012
'Version: 1.0
''''''''''''''''''''''''''''''''''''''''''''''''
'Copyright:
'The code was entirely written by me, Charles Branham.
'Unless otherwise stated.
'All procedures are my work using Ideas gathered from resources available
' ... ie: Microsoft knowledge base. As the distributor and primary
'author of this Module, I welcome you to use it in your application
'however, you MUST NOT gain financially from the use of the module or the code
'within it, in whole or in part! .. If you use my code in your application, then
'please give credit where credit is due. If you want to use my code in a commercial
'application (ie: something someone spends money on), please contact me first...
[EMAIL="'charles.branham@navy.mil"]'charles.branham@navy.mil[/EMAIL], or at [EMAIL="thechazm@live.com"]thechazm@live.com[/EMAIL].
'Thanks for your honesty and cooperation ... Charles Branham
''''''''''''''''''''''''''''''''''''''''''''''''
'Application
'Version Information
'--------------------
'1.0 02/13/2012 Initial Release
Public Function SearchAll(strFormName As String, strCriteria As String)
Dim RFields, R, i As Long, ii As Long, bFirstPass As Boolean
Dim strSQL, strTableName As String, strSQLWHERE
Dim db As Database, rs As DAO.Recordset, iRecID As Long, fForm As Form
NoForm = False
bFirstPass = True
RFields = ReturnFields(strFormName)
If NoForm = True Then Exit Function
i = InStr(1, Forms(strFormName).RecordSource, "from")
If i = 0 Then
'// This is a direct Table
strTableName = "[" & Forms(strFormName).RecordSource & "]"
Else
'// This is a query feeding form. Extract out the table name
strTableName = Mid(Forms(strFormName).RecordSource, i + 5, Len(Forms(strFormName).RecordSource) - i) ' Strips out beginning SQL before table name
If Mid(strTableName, 1, 1) = "[" Then ' Checks if table name used brackets
i = InStr(1, strTableName, "]")
strTableName = Mid(strTableName, 1, i) ' Grabs table name
Else
i = InStr(1, strTableName, "WHERE") ' Finds the WHERE Clause
If i = 0 Then
strTableName = "[" & Mid(strTableName, 1, Len(strTableName) - 1) & "]" ' If no where is found then it builds the table name.
Else
strTableName = "[" & Mid(strTableName, 1, i - 2) & "]" ' If where was found it strips of the end grabbing the table name.
End If
i = InStr(1, strTableName, "ORDER BY")
If i <> 0 Then
strTableName = Mid(strTableName, 1, i - 2) & "]"
End If
End If
End If
'strSQL = "Select * from " & strTableName & " WHERE ["
strSQL = "Select * from " & strTableName
For Each R In RFields
If R = "" Then Exit For
If bFirstPass = True Then
'strSQL = strSQL & R & "] In(Select [" & R & "] from " & strTableName & " WHERE "
' strSQL = strSQL & R & "] In(Select [" & R & "] from " & strTableName & " "
bFirstPass = False
Else
strSQLWHERE = strSQLWHERE & "[" & R & "] LIKE '*" & strCriteria & "*' Or "
End If
Next R
'// Add ) to end of where string
'strSQLWHERE = Mid(strSQLWHERE, 1, Len(strSQLWHERE) - 4) & ")"
strSQLWHERE = Mid(strSQLWHERE, 1, Len(strSQLWHERE) - 4)
'Debug.Print strSQL & strSQLWHERE
Set db = CurrentDb
'Set rs = db.OpenRecordset(strSQL & strSQLWHERE, dbOpenSnapshot)
Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)
Set fForm = Forms(strFormName)
i = fForm.Recordset.AbsolutePosition
rs.MoveLast
rs.MoveFirst
rs.Move i
rs.FindNext strSQLWHERE
If rs.NoMatch = True Then
MsgBox "No records match your search. Please try again.", vbInformation, "Not Found"
rs.Close
Set rs = Nothing
Set db = Nothing
Exit Function
Else
iRecID = rs.Fields(0).Value
rs.Close
Set rs = Forms(strFormName).RecordsetClone
rs.FindFirst rs.Fields(0).Name & " = " & iRecID
If Not rs.EOF Then Forms(strFormName).Bookmark = rs.Bookmark ' Sets form to value!
End If
rs.Close
Set rs = Nothing
Set db = Nothing
End Function
Public Function ReturnFields(strFormName As String) As Variant ' Toggles through the field names that can be searched in the table
Dim R As Variant, i As Long
Dim rs As DAO.Recordset, db As Database
On Error GoTo ErrHandler
Set db = CurrentDb
If CurrentProject.AllForms(strFormName).IsLoaded = False Then
MsgBox "The form has to be loaded for this function to work!"
Exit Function
End If
Set rs = db.OpenRecordset(Forms(strFormName).RecordSource, dbOpenDynaset)
ReDim R(0 To 255)
Do While i <> rs.Fields.Count
R(i) = rs.Fields(i).Name
i = i + 1
Loop
rs.Close
Set rs = Nothing
ReturnFields = R
ErrHandler:
If Err.Number = 2450 Then
MsgBox "The form name you supplied is not valid! Please check your spelling.", vbCritical, "Oops"
NoForm = True
Set rs = Nothing
Exit Function
End If
Resume Next
End Function
