[www.richardsenior.net/projects]
Search a folder and it's subfolders for a string in any access files
<![CDATA[
Dim sb
Dim dbFiles
Sub main()
folder = "C:\eclipse\workspaces\BSP\localisation"
folder = InputBox("Enter the path to the folder which contains the access databases you want to search through","Search Folder", folder)
searchString = "Handsets Details"
searchString = InputBox("Enter the text you want to search for","Search String",searchString)
Set sb = New StringBuffer
sb.append("Searching all Access files in and below " & folder & " for '%" & searchString & "%'" & vbnewline)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(folder)
set dbFiles = new Collection
dbFiles.Name = "All Files"
'get a collection of all the MDB Files
findAccessFiles(objFolder)
'loop over it searching the files, assume that DBFiles.Items is an array of Collection objects
For Each dbFile In dbFiles.Items
findTablesInFile(dbFile)
'now find the string itself
findColumnsInTables(dbFile)
findStringsInColumns dbFile,searchString
next
sb.append("Finished" & vbNewline)
logfolder = "C:\Documents and Settings\SENIOR1\Desktop\findlog.txt"
logfolder = InputBox("where should I write the log?","Logfile Location",logfolder)
writeLog(logfolder)
End Sub
Sub findAccessFiles(pCurrentDir)
For Each aItem In pCurrentDir.Files
If LCase(Right(Cstr(aItem.Name), 3)) = "mdb" Then
set tmpCollection = new Collection
tmpCollection.name = aItem.Path
dbFiles.add(tmpCollection)
End If
Next
For Each aItem In pCurrentDir.SubFolders
findAccessFiles(aItem)
Next
End Sub
sub findTablesInFile(dbFile)
Set CN = CreateObject("ADODB.Connection")
'the name of the file is the full path to the file
CN.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data source=" & dbFile.Name
'get a list of table names
Const adSchemaTables = 20
arrCriteria = Array(Empty, Empty, Empty, "Table")
Set tables = CN.OpenSchema(adSchemaTables, arrCriteria)
Do Until tables.EOF
foo = tables.Fields.Item("TABLE_NAME")
set tmpTable = new Collection
tmpTable.Name = foo
dbFile.add(tmpTable)
tables.MoveNext
Loop
tables.Close
CN.Close
End sub
sub findColumnsInTables(dbFile)
Const adSchemaColumns = 4
Set CN = CreateObject("ADODB.Connection")
'the name of the file is the full path to the file
CN.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data source=" & dbFile.Name
'loop over tables populating them with column names
For Each table In dbFile.items
arrCriteria = Array(Empty, Empty, "" & table.Name)
Set columns = CN.OpenSchema(adSchemaColumns, arrCriteria)
Do While Not columns.EOF
set tmpColumn = new Collection
tmpColumn.Name = columns("COLUMN_NAME")
tmpColumn.DataType = columns("DATA_TYPE")
table.add(tmpColumn)
columns.MoveNext
Loop
columns.Close
Next
CN.Close
End sub
sub findStringsInColumns(dbFile,searchString)
Set CN = CreateObject("ADODB.Connection")
CN.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data source=" & dbFile.Name
For Each table In dbFile.items
For Each column In table.Items
sql = "SELECT * FROM [" & table.Name & "] WHERE [" & column.Name & "] LIKE '%" & searchString & "%'"
set rs = CreateObject("ADODB.recordset")
rs.Open sql, CN
Do While Not rs.EOF
sb.append("found in " & dbfile.name & " in table " & table.name & " column " & column.name & vbNewline)
'sb.append(rs.GetString)
rs.MoveNext
loop
rs.close
Next
Next
CN.Close
end sub
Sub writeLog(logfolder)
Set objFSO = CreateObject("scripting.FileSystemObject")
'Set objTextFile = objFSO.CreateTextFile(logfolder)
'objTextFile.Close
Set objTextFile = objFSO.OpenTextFile(logfolder,8 ,True)
objTextFile.Write(sb.ToString)
objTextFile.Close
objFSO = Empty
End Sub
Class Collection
Private cDataType
Private cName
Private arrContents()
Private bFirstAdd
'*****************************************
Private Sub Class_Initialize()
bFirstAdd = True
End Sub
Private Sub Class_Terminate()
End Sub
'*****************************************
Public Property Get Count()
If bFirstAdd Then
Count = 0
Exit Property
End If
Count = UBound(arrContents) + 1
End Property
Public Property Get Items()
Items = arrContents
End Property
Public Property Get Name()
Name = cName
End Property
Public Property Let Name(oObj)
cName = oObj
End Property
Public Property Get DataType()
DataType = cDataType
End Property
Public Property Let DataType(oObj)
cDataType = oObj
End Property
'*******************************************
Public Sub Add(oItem)
If bFirstAdd Then
ReDim arrContents(0)
bFirstAdd = False
Else
ReDim Preserve arrContents(UBound(arrContents) + 1)
End If
If IsObject(oItem) Then
Set arrContents(UBound(arrContents)) = oItem
Else
arrContents(UBound(arrContents)) = oItem
End If
End Sub
Public Function Sort()
'Returns a sorted array of the items
Sort = BubbleSort(arrContents)
End Function
Public Sub SortInPlace()
BubbleSortInPlace()
End Sub
Private Function BubbleSort( arr )
dim arr_j, arr_j1, i, j, temp
for i = UBound(arr) - 1 To 0 Step -1
for j = 0 to i
arr_j = arr( j )
arr_j1 = arr( j + 1 )
if arr_j > arr_j1 Then
temp=arr_j1
arr(j+1)=arr_j
arr(j)=temp
end If
Next
Next
BubbleSort = arr
End Function
Private Sub BubbleSortInPlace()
dim arr_j, arr_j1, i, j, temp
for i = UBound(arrContents) - 1 To 0 Step -1
for j = 0 to i
arr_j = arrContents( j )
arr_j1 = arrContents( j + 1 )
if arr_j > arr_j1 Then
temp=arr_j1
arrContents(j+1)=arr_j
arrContents(j)=temp
end If
Next
Next
End Sub
Public Function Exists(oItem)
Dim oContentItem
Dim i
i = 0
For Each oContentItem In arrContents
If oContentItem = oItem Then
Exists = i
Exit Function
End If
i = i + 1
Next
Exists = -1
End Function
Public Function Remove(nIndex)
Dim i, j
Dim arrTemp
arrTemp = arrContents
ReDim arrContents(UBound(arrTemp) -1)
j = 0
For i = 0 To UBound(arrTemp)
If Not i = nIndex Then
arrContents(j) = arrTemp(i)
j = j + 1
Else
Remove = arrTemp(i)
End If
Next
End Function
End Class
Class StringBuffer
Private Buffer(), Capacity, Index
Public Default Function ToString()
ToString = Join(Buffer, "")
End Function
Public Sub Append(vAny)
sString = CStr(vAny)
Buffer(Index) = sString
Index = Index + 1
If Index = Capacity Then
Capacity = Capacity + 10
ReDim Preserve Buffer(Capacity-1)
End If
End Sub
Private Sub Class_Initialize()
Capacity = 10
ReDim Buffer(Capacity-1)
Index = 0
End Sub
Private Sub Class_Terminate()
Erase Buffer
End Sub
End Class
main
]]>