Thank you all for your comments on this post. I have solved it I think.
Incidentally, you will find an idea below for a function that allows you to
search for keywords through tables, queries, forms, reports and modules.
You can either search the whole database or the objects held in D-DXS
The table D-DXS holds a list of objects
Fields:
ID - autonumber
Dc = text, name of object
D-DXG-ID = linked to D-DXG.ID
D-TYP-ID = linked to D-TYP.ID, a table which lists the
object types
Fld = text field, which stores informatio on where in the
object the string is found (e.g.a control in a form)
The table D-DXG holds a list of searches
ID autonumber
D = name of search
MEM = extra info on the search
Option Compare Database
Option Explicit
Const TblNS = "D-DXS"
Const TblNGid = "D-DXG-ID"
Const TblNTid = "D-TYP-ID"
Const Qn = 5
Const Fn = -32768
Const Rn = -32764
Const Mn = -32761
Const Tn = 1 'not linked tables
Const TLn = 6 'linked
Dim SS As String
Dim TYPID As Long
Dim DXGID As Long
Dim ObjN As String
Dim FldN As String
Dim Msg As String
Dim RST As Dao.Recordset
Dim Dbs As Database
Dim StbS As String 'the string to be searched
Public Sub Tsearch(S As String, REC As Long, Subsearch As Boolean, linked As
Boolean)
'rec is the id for the group
Dim Tbl As TableDef
'-------------------------------set basics
Set Dbs = CurrentDb
DXGID = REC
If linked Then
TYPID = TLn
Else
TYPID = Tn
End If
SS = S
'--------------delete the previous search entries-------------------
If Not PFDEL(Subsearch) Then Exit Sub
'---------------start loop: two options
If Not Subsearch Then
For Each Tbl In Dbs.TableDefs
Call PSTBL(Tbl)
Next Tbl
Else
Set RST = Dbs.OpenRecordset("SELECT * FROM [" & TblNS & "] WHERE (["
& TblNGid & "]=" & REC & " AND [" & TblNTid & "] = " & TYPID & ";")
Do While Not RST.EOF
Set Tbl = Dbs.TableDefs(RST.Fields("dc"))
Call PSTBL(Tbl)
RST.MoveNext
Loop
End If
finalise:
Call PSFIN
End Sub
Public Sub Qsearch(S As String, REC As Long, Subsearch As Boolean)
Dim QDF As QueryDef
Dim Sqls As String
Dim Dbs As Database
Dim RST As Dao.Recordset
Dim Msg As String
'-------------------------------set basics
Set Dbs = CurrentDb
DXGID = REC
TYPID = Qn
SS = S
'--------------delete the previous search entries-------------------
If Not PFDEL(Subsearch) Then Exit Sub
'---------------start loop: two options search 'if' in help for more
information
If Not Subsearch Then
For Each QDF In Dbs.QueryDefs
Call PSQDF(QDF)
Next QDF
Else
Set RST = Dbs.OpenRecordset("SELECT * FROM [" & TblNS & "] WHERE (["
& TblNGid & "]=" & REC & " AND [" & TblNTid & "] = " & TYPID & ";")
Do While Not RST.EOF
Set QDF = Dbs.QueryDefs(RST.Fields("dc"))
Call PSQDF(QDF)
RST.MoveNext
Loop
End If
finalise:
Call PSFIN
End Sub
Public Sub FRsearch(S As String, REC As Long, Subsearch As Boolean, IsReport
As Boolean)
Dim Ctr As Container
Dim Doc As Document
'-------------------------------set basics
Set Dbs = CurrentDb
DXGID = REC
If IsReport Then TYPID = Rn Else TYPID = Fn
SS = S
'--------------delete the previous search entries-------------------
If Not PFDEL(Subsearch) Then Exit Sub
'---------------start loop: two options search 'if' in help for more
information
If Not Subsearch Then
If IsReport Then
Set Ctr = Dbs.Containers!Reports
Else
Set Ctr = Dbs.Containers!Forms
End If
For Each Doc In Ctr.Documents
ObjN = Doc.Name
Call PSOBJ(IsReport)
Next Doc
Else
Set RST = Dbs.OpenRecordset("SELECT * FROM [" & TblNS & "] WHERE (["
& TblNGid & "]=" & REC & " AND [" & TblNTid & "] = " & TYPID & ";")
Do While Not RST.EOF
ObjN = RST.Fields("dc")
Call PSOBJ(IsReport)
RST.MoveNext
Loop
End If
finalise:
Call PSFIN
End Sub
Public Sub Msearch(S As String, REC As Long, Subsearch As Boolean)
Dim ModO As AccessObject
'--------------set basics------------------------------------
Set Dbs = CurrentDb
DXGID = REC
TYPID = Mn
SS = S
'--------------delete the previous search entries-------------------
If Not PFDEL(Subsearch) Then Exit Sub
'--------------cycle through modules-------------------------------------
For Each ModO In Application.CurrentProject.AllModules
ObjN = ModO.Name
Call PFSMO(ModO.Name, SS)
looper:
Next ModO
finalise:
Call PSFIN
End Sub
Private Function PFADD()
'add new entries to D-DXG
Msg = Msg & vbCrLf & ObjN & " (" & FldN & ")"
If Nz(FldN, "") <> "" Then FldN = FldN & ", "
Call FRUNSQL("UPDATE [D-DXS] SET [D-DXS].FLD = [FLD] & '" & FldN & "'
WHERE ((([D-DXS].Dc)='" & ObjN & "') AND (([D-DXS].[D-TYP-ID])=" & TYPID &
") AND (([D-DXS].[D-DXG-ID])=" & DXGID & "));")
Call FRUNSQL("INSERT INTO [D-DXS] ( Dc, [D-DXG-ID], [D-TYP-ID], [FLD] )
SELECT '" & ObjN & "' AS v1, " & DXGID & " AS v2, " & TYPID & " AS v3, '" &
FldN & "' AS v4;")
xit:
Exit Function
Err:
Resume xit
End Function
Private Function PFDEL(Subsearch As Boolean) As Boolean
'deletes entries from D-DXS
PFDEL = True
If Subsearch Then
GoTo xit
Else
If FRSHOW(206) Then
Call FRUNSQL("DELETE [" & TblNS & "].* FROM [" & TblNS & "]
WHERE ([" & TblNGid & "]=" & DXGID & " And [" & TblNTid & "] = " & TYPID &
");")
Else
PFDEL = False
End If
End If
xit:
Exit Function
Err:
Resume xit
End Function
Private Function PFONC()
'object name check: see if the string perhaps occurs in the name of the
object itself
If InStr(1, ObjN, SS, vbDatabaseCompare) > 0 Then
FldN = ""
Call PFADD
End If
xit:
Exit Function
Err:
Resume xit
End Function
Private Sub PSFIN()
If Msg = "" Then Msg = SS & " WAS NOT FOUND"
MsgBox "FOUND IN THE FOLLOWING: " & vbCr &
"________________________________" & Msg
Forms("D-SEA").Requery
End Sub
Private Function PFSMO(MdlN As String, SS As String)
Dim Mdl As Module
Dim SLine As Long, SCol As Long 'start line and column (character)
Dim ELine As Long, ECol As Long 'end line and column (character)
'--------------------select case: form, report or module
Select Case TYPID
Case Fn
If Not Forms(ObjN).HasModule Then Exit Function
Set Mdl = Forms(ObjN).Module
Case Rn
If Not Reports(ObjN).HasModule Then Exit Function
Set Mdl = Reports(ObjN).Module
Case Else
DoCmd.OpenModule MdlN
Set Mdl = Modules(MdlN)
DoCmd.Close acModule, MdlN, acSaveNo
'----------check name itself
Call PFONC
End Select
'--------------search the module
If Mdl.find(SS, SLine, SCol, ELine, ECol) Then
FldN = "(ModuleLine: " & SLine & ")"
PFADD
End If
End Function
Private Sub PSTBL(Tbl As TableDef)
Dim Fld As Field
'-------------------------------------------
ObjN = Tbl.Name
If Left(ObjN, 1) = "~" Then Exit Sub
'--------check object name--------------------
Call PFONC
'--------search fields--------------------
For Each Fld In Tbl.Fields
StbS = Fld.Name & " "
If InStr(1, StbS, SS, vbDatabaseCompare) > 0 Then
FldN = Fld.Name
Call PFADD
End If
Next Fld
End Sub
Private Sub PSQDF(QDF As QueryDef)
'------------------actual search-----------------------------------------
ObjN = QDF.Name
If Left(ObjN, 1) = "~" Then Exit Sub
'---check name-------------------------
Call PFONC
'---check sqls-------------------------------
StbS = QDF.SQL
If InStr(1, StbS, SS, vbDatabaseCompare) > 0 Then
Call PFADD
End If
End Sub
Private Sub PSOBJ(IsReport As Boolean)
Dim OBJ As Object
Dim Ctl As Control
Dim ppt As Property
'---------------cater for forms/reports that do not need to be
searched-------------
If Left(ObjN, 1) = "X" Then Exit Sub
If Left(ObjN, 1) = "D" Then Exit Sub
If DCount("[ID]", "[D-TAB]", "[D-TAB]![Dc]='" & Left(ObjN, 5) & "'") > 0
Then Exit Sub
If Left(ObjN, 1) = "~" Then Exit Sub
'---open report/form-------------------------------
If IsReport Then
DoCmd.OpenReport ObjN, acViewDesign, , , acHidden
Set OBJ = Reports(ObjN)
Else
DoCmd.OpenForm ObjN, acDesign, "", "", acFormPropertySettings,
acHidden, ""
Set OBJ = Forms(ObjN)
End If
'---check name and module-------------------------
Call PFONC
Call PFSMO("", SS)
'---------------------------------------search form/report
StbS = ""
For Each ppt In OBJ.Properties
If property_check(ppt.Name) <> False Then
StbS = StbS & ppt.Value
End If
Next ppt
If InStr(1, StbS, SS, vbDatabaseCompare) > 0 Then
FldN = "object properties"
Call PFADD
End If
'---------------------------------------search controls
StbS = ""
For Each Ctl In OBJ.Controls
For Each ppt In Ctl.Properties
If property_check(ppt.Name) <> False Then
StbS = StbS & ppt.Value
End If
Next ppt
If InStr(1, StbS, SS, vbDatabaseCompare) > 0 Then
FldN = Ctl.Name
Call PFADD
End If
Next Ctl
'------------------close
form/report-----------------------------------------
If IsReport Then
DoCmd.Close acReport, ObjN, acSaveNo
Else
DoCmd.Close acForm, ObjN, acSaveNo
End If
End Sub
---
Please immediately let us know (by phone or return email) if (a) this email
contains a virus
(b) you are not the intended recipient
(c) you consider this email to be spam.
We have done our utmost to make sure that
none of the above are applicable. THANK YOU
Checked by AVG anti-virus system (
http://www.grisoft.com).
Version: 6.0.700 / Virus Database: 457 - Release Date: 06/06/2004