07-09-04 05:05 PM
It most certainly is.
I wrote the code below for exstensive searches . It will run your
search, create a new table by the name of your search, and populate it
with your search results and the files properties.
To use:
Create a new access database and create a new module and form. Copy
the below code into the form. Make 3 text fields for the catalog,
directory/scope to search, and then your search term.
You will need to make references to activeX, dao, and office 11 object
library
Hope it helps.
-----------------------------
Option Compare Database
Dim blnError As Boolean
Private Sub cmdDir_Click()
GetDir ("Select the Directory you wish to search")
Me.txtDir = strLoc
End Sub
Private Sub cmdSearch_Click()
CheckValues
If blnError = True Then
Exit Sub
Else
Call Search(Me.txtSearch, Me.txtDir, Me.txtCatalog)
End If
End Sub
Sub CheckValues()
blnError = False
If IsNull(Me.txtCatalog) Then blnError = True
If IsNull(Me.txtDir) Then blnError = True
If IsNull(Me.txtSearch) Then blnError = True
If blnError = True Then
MsgBox "Please make sure all of the fields are filled in
correctly", vbCritical, "Error"
End If
End Sub
-------------------
Copy in the Code below into the module
------
Function Search(strSearch As String, strDir As String, strSource As
String)
Dim RS As New ADODB.Recordset
Dim rsResults As DAO.Recordset
Dim db As DAO.Database
Dim strQueryText As String
Dim SQL1 As String
Dim i As Integer
Set db = CurrentDb
On Error Resume Next
'query for index server. it can be as long as you like
strQueryText = "CONTAINS('" & Chr(34) & strSearch & Chr(34) & "')
> 0 "
' uncomment the below code to perform searches using multiple terms
' strQueryText = "CONTAINS('" & Chr(34) & "1" & Chr(34) _
' & " or " & Chr(34) & "2" & Chr(34) _
' & " or " & Chr(34) & "3" & Chr(34) _
' & " or " & Chr(34) & "4" & Chr(34) & "') > 0 "
'i = 1
Const adOpenForwardOnly = 0
Connect = "provider=msidxs;Data Source=" & strSource
CommandText = "SELECT classid, characterization, create,
docappname, " _
& "docauthor, docbytecount, doccategory,doccharcount,
doccompany, " _
& "doccreatedtm, docedittime, docKeywords,
docLastAuthor, " _
& "DocLastPrinted, DocLastSavedTm, DocPageCount,
DocParaCount, " _
& "DocPartTitles, DocRevNumber, DocSlideCount,
DocSubject, " _
& "DocTitle, DocWordCount, FileIndex, FileName,
HitCount, " _
& "Rank, Size, USN, Write " _
& "FROM Scope('" + Chr(34) + strDir + Chr(34) + "') "
_
& "WHERE " + strQueryText + ""
RS.Open CommandText, Connect, adOpenKeyset
DoCmd.SetWarnings (False)
RS.MoveLast
If RS.RecordCount > 0 Then
MkTable (strSearch)
RS.MoveFirst
Set rsResults = db.OpenRecordset("Select * from tbl" &
strSearch)
Do Until RS.EOF = True
With rsResults
.AddNew
!ClassID = RS.Fields(0)
!Characterization = RS.Fields(1)
!Create = RS.Fields(2)
!DocAppName = RS.Fields(3)
!DocAuthor = RS.Fields(4)
!DocByteCount = RS.Fields(5)
!DocCategory = RS.Fields(6)
!DocCharCount = RS.Fields(7)
!DocCompany = RS.Fields(8)
!DocCreatedTm = RS.Fields(9)
!DocEditTime = RS.Fields(10)
!DocKeywords = RS.Fields(11)
!DocLastAuthor = RS.Fields(12)
!DocLastPrinted = RS.Fields(13)
!DocLastSavedTm = RS.Fields(14)
!DocPageCount = RS.Fields(15)
!DocParaCount = RS.Fields(16)
!DocPartTitles = RS.Fields(17)
!DocRevNumber = RS.Fields(18)
!DocSlideCount = RS.Fields(19)
!DocSubject = RS.Fields(20)
!DocTitle = RS.Fields(21)
!DocWordCount = RS.Fields(22)
!FileIndex = RS.Fields(23)
!FileName = RS.Fields(24)
!HitCount = RS.Fields(25)
!Rank = RS.Fields(26)
!Size = RS.Fields(27)
!USN = RS.Fields(28)
!Write = RS.Fields(29)
.Update
End With
RS.MoveNext
'i = i + 1
Loop
End If
DoCmd.SetWarnings (True)
MsgBox UCase(strSearch) & "Search Complete"
End Function
Sub MkTable(strTable As String)
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fldTemp As DAO.Field
On Error Resume Next
Set db = CurrentDb
strTable = "tbl" & strTable
DoCmd.DeleteObject acTable, strTable
Set tdf = db.CreateTableDef(strTable)
Set fldTemp = tdf.CreateField("ClassID", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("Characterization", dbMemo)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("Create", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("DocAppName", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("DocAuthor", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("DocByteCount", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("DocCategory", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("DocCharCount", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("DocCompany", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("DocCreatedTm", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("DocEditTime", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("DocKeywords", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("DocLastAuthor", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("DocLastPrinted", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("DocLastSavedTm", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("DocPageCount", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("DocParaCount", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("DocPartTitles", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("DocRevNumber", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("DocSlideCount", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("DocSubject", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("DocTitle", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("DocWordCount", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("FileIndex", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("FileName", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("HitCount", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("Rank", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("Size", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("USN", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
Set fldTemp = tdf.CreateField("Write", dbText, 255)
fldTemp.AllowZeroLength = True
tdf.Fields.Append fldTemp
db.TableDefs.Append tdf
End Sub
Function GetDir(strTitle As String)
Dim fdFileLoc As FileDialog
Set fdFileLoc = Application.FileDialog(msoFileDialogFolderPicker)
fdFileLoc.Title = strTitle
fdFileLoc.Show
strLoc = fdFileLoc.SelectedItems(1)
If Right(strLoc, 1) <> "\" Then strLoc = strLoc & "\"
End Function
[ Post a follow-up to this message ]
|
