<HTML>
<HEAD>
<TITLE>OAC OpenSchema Testing</TITLE>
</HEAD>
<BODY>
<DIV ALIGN="left">
<H3>Extracting properties of a database table</H3>
<B>This example created by Ohman Automation Corp. (OAC)</B>
- <A HREF="http://www.OhmanCorp.com">www.OhmanCorp.com</A><BR><BR>
<B>Information extracted using OpenSchema(adSchemaColumns) from an ADODB.Connection object,
all column properties</B><BR>
<%
'--------------------------------------------------------------------------------------------
' The purpose of this Active Server Page was to pull in MS Access field information, for use
' in ASP and VBS.
' Creator: Jay Ohman, Ohman Automation Corp. - http://www.OhmanCorp.com
' Use of this information is strictly at your own risk, I/we can not be held liable for use
' of this information.
' The sharing of this information is allowed, with these notes intact.
' for more information, and introduction, see http://www.OhmanCorp.com/ADO-DBProps.asp
'
' basic copy from: http://www.davidpenton.com/testsite/scratch/adOpenSchema.asp, fairly tweaked
' good ref: http://msdn2.microsoft.com/en-gb/library/ms675274.aspx, all the OpenSchema types
'--------------------------------------------------------------------------------------------
Dim xFlds() 'As Variant
' On Error Resume Next
' For this type of research, I'd rather have the error and line no. reported
xTableName = "Products"
xSourceDB = "C:\Program Files\Microsoft Office\OFFICE\SAMPLES\Northwind.mdb" ' Access 97
' xSourceDB = "C:\Program Files\Microsoft Office\OFFICE11\SAMPLES\Northwind.mdb" ' Access 2003
' tweak path if needed, note that this will be the path on the IIS server
' or point to your own database
' xInd = vbTab
xInd = " "
Set Conn = Server.CreateObject("ADODB.Connection")
StrConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & xSourceDB
Conn.Open StrConn
Set Session("ListProps_conn") = Conn
Set TablesSchema = Conn.OpenSchema(20) ' 20 = adSchemaTables
' establish database connection, and open the Table Schema
Do While Not TablesSchema.EOF
If TablesSchema("TABLE_NAME") = xTableName Then
Set xSchema = Conn.OpenSchema(4, Array(Empty, Empty, "" & TablesSchema("TABLE_NAME")))
' 4 = adSchemaColumns
xData = xSchema.GetRows(-1) ' -1 = adGetRowsRest
xCols = UBound(xData, 1)
xRows = UBound(xData, 2)
ReDim xFlds(xCols)
For i = 0 to xCols
xFlds(i) = xSchema.Fields.Item(i).Name
Next
xSchema.Close
Response.Write("<TABLE BORDER=1 CELLSPACING=0>" & vbCrLf & xInd & "<TR>" & vbCrLf)
For i = 0 to xCols
Response.Write(xInd & xInd & "<TH>" & xFlds(i) & "</TH>" & vbCrLf)
Next
Response.Write(xInd & "</TR>" & vbCrLf)
For j = 0 to xRows
Response.Write(xInd & "<TR>" & vbCrLf)
For i = 0 to xCols
If (IsNull(xData(i, j))) OR (xData(i, j) = "") Then xStr = " " _
Else xStr = Trim(xData(i, j))
Response.Write(xInd & xInd & "<TD>" & xStr & "</TD>" & vbCrLf)
Next
Response.Write(xInd & "</TR>" & vbCrLf)
Next
Response.Write("</TABLE><BR>" & vbCrLf) %>
<B>Information extracted from all the Field Properties</B><BR>
<%
' I found this while looking for a way to determine if a field as set to AutoIncrement
Set rst1 = Server.CreateObject("ADODB.Recordset")
StrSQL = "SELECT * FROM " & xTableName & ";"
rst1.Open StrSQL, Conn, 3, 1
Response.Write("<TABLE BORDER=1 CELLSPACING=0>" & vbCrLf & xInd & "<TR>" & _
vbCrLf)
For j = 0 To (rst1.Fields(0).Properties.Count - 1)
Response.Write(xInd & xInd & "<TH>" & rst1.Fields(0).Properties(j).Name & _
"</TH>" & vbCrLf)
Next
Response.Write(xInd & "</TR>" & vbCrLf)
For i = 0 To (rst1.Fields.Count - 1)
Response.Write(xInd & "<TR>" & vbCrLf)
For j = 0 To (rst1.Fields(i).Properties.Count - 1)
Response.Write(xInd & xInd & "<TD>" & rst1.Fields(i).Properties(j).Value & _
"</TD>" & vbCrLf)
Next
Response.Write(xInd & "</TR>" & vbCrLf)
Next
Response.Write("</TABLE><BR>" & vbCrLf)
rst1.Close
Set rst1 = Nothing
End If
TablesSchema.MoveNext
Loop
TablesSchema.Close
'--------------------------------------------------------------------------------------------
' I now experimented with the different SchemaEnum values, and found the following to be most
' useful for pulling field and relationship information into VB Scripting. There was no
' apparent harm in trying different values, other than the data connector would return an
' error if the SchemaEnum value was not supported by Access.
'--------------------------------------------------------------------------------------------
%>
<B>Information extracted using OpenSchema(adSchemaKeyColumnUsage ) from an ADODB.Connection
object, all constraint properties</B><BR>
<%
Set xSchema = Conn.OpenSchema(8) ' 8 = adSchemaKeyColumnUsage
xData = xSchema.GetRows(-1) ' -1 = adGetRowsRest
xCols = UBound(xData, 1)
xRows = UBound(xData, 2)
ReDim xFlds(xCols)
For i = 0 to xCols
xFlds(i) = xSchema.Fields.Item(i).Name
Next
xSchema.Close
Set xSchema = Nothing
Response.Write("<TABLE BORDER=1 CELLSPACING=0>" & vbCrLf & xInd & "<TR>" & vbCrLf)
For i = 0 to xCols
Response.Write(xInd & xInd & "<TH>" & xFlds(i) & "</TH>" & vbCrLf)
Next
Response.Write(xInd & "</TR>" & vbCrLf)
For j = 0 to xRows
If Left( xData(5 , j), 10) <> "MSysAccess" Then
Response.Write(xInd & "<TR>" & vbCrLf)
For i = 0 to xCols
If (IsNull(xData(i, j))) OR (xData(i, j) = "") Then xStr = " " _
Else xStr = Trim(xData(i, j))
Response.Write(xInd & xInd & "<TD>" & xStr & "</TD>" & vbCrLf)
Next
Response.Write(xInd & "</TR>" & vbCrLf)
End If
Next
Response.Write("</TABLE><BR>" & vbCrLf)
'--------------------------------------------------------------------------------------------
%>
<B>Information extracted using OpenSchema(adSchemaReferentialConstraints) from an
ADODB.Connection object, all Referential properties</B><BR>
<%
Set xSchema = Conn.OpenSchema(9) ' 9 = adSchemaReferentialConstraints
xData = xSchema.GetRows(-1) ' -1 = adGetRowsRest
xCols = UBound(xData, 1)
xRows = UBound(xData, 2)
ReDim xFlds(xCols)
For i = 0 to xCols
xFlds(i) = xSchema.Fields.Item(i).Name
Next
xSchema.Close
Set xSchema = Nothing
Response.Write("<TABLE BORDER=1 CELLSPACING=0>" & vbCrLf & xInd & "<TR>" & vbCrLf)
For i = 0 to xCols
Response.Write(xInd & xInd & "<TH>" & xFlds(i) & "</TH>" & vbCrLf)
Next
Response.Write(xInd & "</TR>" & vbCrLf)
For j = 0 to xRows
Response.Write(xInd & "<TR>" & vbCrLf)
For i = 0 to xCols
If (IsNull(xData(i, j))) OR (xData(i, j) = "") Then xStr = " " _
Else xStr = Trim(xData(i, j))
Response.Write(xInd & xInd & "<TD>" & xStr & "</TD>" & vbCrLf)
Next
Response.Write(xInd & "</TR>" & vbCrLf)
Next
Response.Write("</TABLE><BR>" & vbCrLf)
'--------------------------------------------------------------------------------------------
%>
<B>Information extracted using OpenSchema(adSchemaForeignKeys) from an ADODB.Connection
object, all Referential properties</B><BR>
<%
Set xSchema = Conn.OpenSchema(27) ' 27 = adSchemaForeignKeys
xData = xSchema.GetRows(-1) ' -1 = adGetRowsRest
xCols = UBound(xData, 1)
xRows = UBound(xData, 2)
ReDim xFlds(xCols)
For i = 0 to xCols
xFlds(i) = xSchema.Fields.Item(i).Name
Next
xSchema.Close
Set xSchema = Nothing
Response.Write("<TABLE BORDER=1 CELLSPACING=0>" & vbCrLf & xInd & "<TR>" & vbCrLf)
For i = 0 to xCols
Response.Write(xInd & xInd & "<TH>" & xFlds(i) & "</TH>" & vbCrLf)
Next
Response.Write(xInd & "</TR>" & vbCrLf)
For j = 0 to xRows
Response.Write(xInd & "<TR>" & vbCrLf)
For i = 0 to xCols
If (IsNull(xData(i, j))) OR (xData(i, j) = "") Then xStr = " " _
Else xStr = Trim(xData(i, j))
Response.Write(xInd & xInd & "<TD>" & xStr & "</TD>" & vbCrLf)
Next
Response.Write(xInd & "</TR>" & vbCrLf)
Next
Response.Write("</TABLE><BR>" & vbCrLf)
'--------------------------------------------------------------------------------------------
%>
<B>Information extracted using OpenSchema(adSchemaForeignKeys) from an ADODB.Connection
object, all Referential properties</B><BR>
<%
Set xSchema = Conn.OpenSchema(20) ' 20 = adSchemaTables
xData = xSchema.GetRows(-1) ' -1 = adGetRowsRest
xCols = UBound(xData, 1)
xRows = UBound(xData, 2)
ReDim xFlds(xCols)
For i = 0 to xCols
xFlds(i) = xSchema.Fields.Item(i).Name
Next
xSchema.Close
Set xSchema = Nothing
Response.Write("<TABLE BORDER=1 CELLSPACING=0>" & vbCrLf & xInd & "<TR>" & vbCrLf)
For i = 0 to xCols
Response.Write(xInd & xInd & "<TH>" & xFlds(i) & "</TH>" & vbCrLf)
Next
Response.Write(xInd & "</TR>" & vbCrLf)
For j = 0 to xRows
Response.Write(xInd & "<TR>" & vbCrLf)
For i = 0 to xCols
If (IsNull(xData(i, j))) OR (xData(i, j) = "") Then xStr = " " _
Else xStr = Trim(xData(i, j))
Response.Write(xInd & xInd & "<TD>" & xStr & "</TD>" & vbCrLf)
Next
Response.Write(xInd & "</TR>" & vbCrLf)
Next
Response.Write("</TABLE><BR>" & vbCrLf)
'--------------------------------------------------------------------------------------------
Conn.Close
Set Conn = Nothing %>
</BODY>
</HTML>
|