Here a QA program that I have in Excel. the user clicks a button then this
program loops through all the mdb files in a folder on our network. Each
database has the same 12 tables but the databases all have different names.
The program does a query on each table---just a simple record cound and then
prints the database name, table name and record cound in the spreadsheet. it
works really well and has reduced a 6 hour job to about 20 minutes. there's
just one more thing I need to add. I need to check each table for a primary
key. If there is one I would like to add it to this line as a variable.

ActiveCell.FormulaR1C1 = DBName & ";" & table & ";" & _
rs.Fields("Count").Value

thanks,


Sub CommandButton1_Click()
Dim rs As Recordset
Dim SQlcmd As String
Dim myTables As Variant
Dim table As Variant
Dim DBName As String
Dim rows As Integer

Call testfile

On Error Resume Next

Set LastCellInA = Sheet3.Range("A:A").SpecialCells(xlCellTypeLastCel l)
UsedRowsInA = LastCellInA.Row



myTables = Array("[FDMS Billing Fees]", _
"[FDMS Card Entitlements]", _
"[FDMS Card Specific Amex]", _
"[FDMS FEE History]", _
"[FDMS financial history]", _
"[FDMS financial history 2]", _
"[FDMS Link New Xref]", _
"[FDMS Merchant ABA/DDA New]", _
"[FDMS Merchant Funding Category DDAs]", _
"[FDMS Merchant Control Data]", _
"[tblFDMSInternationalGeneral]", _
"[tbl_FDMS_PhaseII_Additional_info]")



'DBName = ListBankNames.Value


For rows = 1 To UsedRowsInA

DBName = Sheet3.Cells(rows, 1)


For Each table In myTables

SQlcmd = "Select Count(*) as [Count] From " & table

Set rs = New ADODB.Recordset

rs.Open Source:=SQlcmd, _
ActiveConnection:="Provider=Microsoft.Jet.OLEDB.4. 0; Data Source=N:\Data
Warehouse\Dallas\MASSCD\AccessDatabases\" + _
DBName + "; User Id=admin; Password="

Range("A65000").End(xlUp).Offset(1, 0).Activate




ActiveCell.FormulaR1C1 = DBName & ";" & table & ";" & _
rs.Fields("Count").Value

Next table

Next rows

Application.DisplayAlerts = False

Call TextToColumns

Application.DisplayAlerts = True
End Sub


Public Sub testfile()
Dim fso, fo, fl, f
Dim r
r = 1
Set fso = CreateObject("Scripting.filesystemobject")
Set fo = fso.getfolder("N:\Data Warehouse\Dallas\MASSCD\AccessDatabases\")
Set fl = fo.Files
For Each f In fl
If Right(f.Name, 3) = "mdb" Then
Sheet3.Cells(r, 1) = f.Name
r = r + 1
End If
Next
End Sub
--
Billy Rogers

Dallas,TX

Currently Using Office 2000

Hi BillyRogers,

You can use the OpenSchema method of the Connection object to return a
resultset of the indexes a table has. It would be easier to manage if you
had a Connection object set up - then you could open the recordset and the
schema from that same connection.

Dim cn As ADODB.Connection
Dim rs2 As ADODB.Recordset

Set cn = New ADODB.Connection

With cn
.ConnectionString = "<your connection string here"
.Open
End With

Set rs2 = cn.OpenSchema(adSchemaIndexes, _
Array(Empty, Empty, Empty, Empty, table)) '/ assumes table var
contains table name
rs.Find ("PRIMARY_KEY = True")

If Not (rs.EOF Or rs.BOF) Then
MsgBox "table contains primary key"
Else
MsgBox "no primary key"
End If

rs2.Close
Set rs2 = Nothing

To open your other Recordset, you can use the Execute method of the
Connection object. And you don't need to set rs to a new Recordset - that
will be done via the return value of the Execute method:

Set rs = cn.Execute("SELECT COUNT(*) AS [Count] FROM [" & table &
"]")

This way, you can reuse the connection. Hopefully this makes some sense and
works for you.

--
Regards,

Jake Marx
www.longhead.com


[please keep replies in the newsgroup - email address unmonitored]

BillyRogers wrote:
Here a QA program that I have in Excel. the user clicks a button
then this program loops through all the mdb files in a folder on our
network. Each database has the same 12 tables but the databases all
have different names. The program does a query on each table---just a
simple record cound and then prints the database name, table name and
record cound in the spreadsheet. it works really well and has
reduced a 6 hour job to about 20 minutes. there's just one more
thing I need to add. I need to check each table for a primary key.
If there is one I would like to add it to this line as a variable.

ActiveCell.FormulaR1C1 = DBName & ";" & table & ";" & _
rs.Fields("Count").Value

thanks,


Sub CommandButton1_Click()
Dim rs As Recordset
Dim SQlcmd As String
Dim myTables As Variant
Dim table As Variant
Dim DBName As String
Dim rows As Integer

Call testfile

On Error Resume Next

Set LastCellInA = Sheet3.Range("A:A").SpecialCells(xlCellTypeLastCel l)
UsedRowsInA = LastCellInA.Row



myTables = Array("[FDMS Billing Fees]", _
"[FDMS Card Entitlements]", _
"[FDMS Card Specific Amex]", _
"[FDMS FEE History]", _
"[FDMS financial history]", _
"[FDMS financial history 2]", _
"[FDMS Link New Xref]", _
"[FDMS Merchant ABA/DDA New]", _
"[FDMS Merchant Funding Category DDAs]", _
"[FDMS Merchant Control Data]", _
"[tblFDMSInternationalGeneral]", _
"[tbl_FDMS_PhaseII_Additional_info]")



'DBName = ListBankNames.Value


For rows = 1 To UsedRowsInA

DBName = Sheet3.Cells(rows, 1)


For Each table In myTables

SQlcmd = "Select Count(*) as [Count] From " & table

Set rs = New ADODB.Recordset

rs.Open Source:=SQlcmd, _
ActiveConnection:="Provider=Microsoft.Jet.OLEDB.4. 0; Data
Source=N:\Data Warehouse\Dallas\MASSCD\AccessDatabases\" + _
DBName + "; User Id=admin; Password="

Range("A65000").End(xlUp).Offset(1, 0).Activate




ActiveCell.FormulaR1C1 = DBName & ";" & table & ";" & _
rs.Fields("Count").Value

Next table

Next rows

Application.DisplayAlerts = False

Call TextToColumns

Application.DisplayAlerts = True
End Sub


Public Sub testfile()
Dim fso, fo, fl, f
Dim r
r = 1
Set fso = CreateObject("Scripting.filesystemobject")
Set fo = fso.getfolder("N:\Data
Warehouse\Dallas\MASSCD\AccessDatabases\") Set fl = fo.Files
For Each f In fl
If Right(f.Name, 3) = "mdb" Then
Sheet3.Cells(r, 1) = f.Name
r = r + 1
End If
Next
End Sub

Thanks for the help. It was a little too complicated for me to integrage the
primary key check into the record count program so i built a separate program
to check the primary keys. Maybe now I'll work on integrating the two.

I just thought I'd post my solution in case anyone else has a similar problem.


Sub DBLoop()

Sheets("Sheet2").Select
Columns("A:A").Select
Selection.ClearContents
Columns("B:B").Select
Selection.ClearContents
Columns("C:C").Select
Selection.ClearContents


Sheets("Sheet3").Select
Columns("A:A").Select
Selection.ClearContents


Dim myRow As Integer
Dim status As String
Dim rs As Recordset
Dim SQlcmd As String
Dim myTables As Variant
Dim table As Variant
Dim DBNAme As String
Dim rows As Integer
Dim DBNameShort
Call testfile

myRow = 1


On Error Resume Next

Set LastCellInA = Sheet3.Range("A:A").SpecialCells(xlCellTypeLastCel l)
UsedRowsInA = LastCellInA.Row


myTables = Array(
'*************put table names here in quotes separated by commas

)

For rows = 1 To UsedRowsInA

DBNAme = Sheet3.Cells(rows, 1)



Dim cn As ADODB.Connection
Dim rs2 As ADODB.Recordset
Set cn = New ADODB.Connection
With cn
'*********************Change folder path here

.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data
Source=N:\Folder\" + _
DBNAme + "; User Id=admin; Password="
.Open

End With
For Each table In myTables
Set rs2 = cn.OpenSchema(adSchemaIndexes, Array(Empty, Empty, Empty, Empty,
table))

rs2.Find ("PRIMARY_KEY=True")

If Not (rs2.EOF Or rs2.BOF) Then
'MsgBox DBNAme & " " & table & " table contains primary key"
status = "Primary Key Present"
Else
'MsgBox DBNAme & " " & table & " has No primary Key"
status = "No Primary Key"
End If



Range("A65000").End(xlUp).Offset(1, 0).Activate


DBNameShort = Left(DBNAme, Len(DBNAme) - 4)

Sheet2.Cells(myRow, 1) = DBNameShort & ";" & table & ";" & status


myRow = myRow + 1

' MsgBox DBNAme & table
Next table


Next rows
Call TextToColumns

MsgBox "Done!"

End Sub

Public Sub testfile()
Dim fso, fo, fl, f
Dim r
r = 1
Set fso = CreateObject("Scripting.filesystemobject")

'***********************change folder path here

Set fo = fso.getfolder("N:\Folder\")
Set fl = fo.Files
For Each f In fl
If Right(f.Name, 3) = "mdb" Then
Sheet3.Cells(r, 1) = f.Name
'Debug.Print f.Name
'do your stuff
r = r + 1
End If
Next
End Sub

Sub TextToColumns()
'
' TextToColumns Macro
' Macro recorded 3/8/2006 by Billy Rogers
'

'
Sheets("Sheet2").Select
Range("a1:a10000").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=False, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1))

Range("a2").Select
End Sub

--
Billy Rogers

Dallas,TX

Currently Using Office 2000 and Office 2003


"Jake Marx" wrote:

Hi BillyRogers,

You can use the OpenSchema method of the Connection object to return a
resultset of the indexes a table has. It would be easier to manage if you
had a Connection object set up - then you could open the recordset and the
schema from that same connection.

Dim cn As ADODB.Connection
Dim rs2 As ADODB.Recordset

Set cn = New ADODB.Connection

With cn
.ConnectionString = "<your connection string here"
.Open
End With

Set rs2 = cn.OpenSchema(adSchemaIndexes, _
Array(Empty, Empty, Empty, Empty, table)) '/ assumes table var
contains table name
rs.Find ("PRIMARY_KEY = True")

If Not (rs.EOF Or rs.BOF) Then
MsgBox "table contains primary key"
Else
MsgBox "no primary key"
End If

rs2.Close
Set rs2 = Nothing

To open your other Recordset, you can use the Execute method of the
Connection object. And you don't need to set rs to a new Recordset - that
will be done via the return value of the Execute method:

Set rs = cn.Execute("SELECT COUNT(*) AS [Count] FROM [" & table &
"]")

This way, you can reuse the connection. Hopefully this makes some sense and
works for you.

--
Regards,

Jake Marx
www.longhead.com


[please keep replies in the newsgroup - email address unmonitored]

BillyRogers wrote:
Here a QA program that I have in Excel. the user clicks a button
then this program loops through all the mdb files in a folder on our
network. Each database has the same 12 tables but the databases all
have different names. The program does a query on each table---just a
simple record cound and then prints the database name, table name and
record cound in the spreadsheet. it works really well and has
reduced a 6 hour job to about 20 minutes. there's just one more
thing I need to add. I need to check each table for a primary key.
If there is one I would like to add it to this line as a variable.

ActiveCell.FormulaR1C1 = DBName & ";" & table & ";" & _
rs.Fields("Count").Value

thanks,


Sub CommandButton1_Click()
Dim rs As Recordset
Dim SQlcmd As String
Dim myTables As Variant
Dim table As Variant
Dim DBName As String
Dim rows As Integer

Call testfile

On Error Resume Next

Set LastCellInA = Sheet3.Range("A:A").SpecialCells(xlCellTypeLastCel l)
UsedRowsInA = LastCellInA.Row



myTables = Array("[FDMS Billing Fees]", _
"[FDMS Card Entitlements]", _
"[FDMS Card Specific Amex]", _
"[FDMS FEE History]", _
"[FDMS financial history]", _
"[FDMS financial history 2]", _
"[FDMS Link New Xref]", _
"[FDMS Merchant ABA/DDA New]", _
"[FDMS Merchant Funding Category DDAs]", _
"[FDMS Merchant Control Data]", _
"[tblFDMSInternationalGeneral]", _
"[tbl_FDMS_PhaseII_Additional_info]")



'DBName = ListBankNames.Value


For rows = 1 To UsedRowsInA

DBName = Sheet3.Cells(rows, 1)


For Each table In myTables

SQlcmd = "Select Count(*) as [Count] From " & table

Set rs = New ADODB.Recordset

rs.Open Source:=SQlcmd, _
ActiveConnection:="Provider=Microsoft.Jet.OLEDB.4. 0; Data
Source=N:\Data Warehouse\Dallas\MASSCD\AccessDatabases\" + _
DBName + "; User Id=admin; Password="

Range("A65000").End(xlUp).Offset(1, 0).Activate




ActiveCell.FormulaR1C1 = DBName & ";" & table & ";" & _
rs.Fields("Count").Value

Next table

Next rows

Application.DisplayAlerts = False

Call TextToColumns

Application.DisplayAlerts = True
End Sub


Public Sub testfile()
Dim fso, fo, fl, f
Dim r
r = 1
Set fso = CreateObject("Scripting.filesystemobject")
Set fo = fso.getfolder("N:\Data
Warehouse\Dallas\MASSCD\AccessDatabases\") Set fl = fo.Files
For Each f In fl
If Right(f.Name, 3) = "mdb" Then
Sheet3.Cells(r, 1) = f.Name
r = r + 1
End If
Next
End Sub