Public Function ListFields(sConnect As String, stable As String, sFields As String, iErrCode As Integer, sErrMsg As String)
Dim catDB As ADOX.Catalog
Dim sCol As ADOX.Column
Dim sKey As ADOX.Key
Dim sInd As ADOX.Index
Dim objContext As COMSVCSLib.ObjectContext
Dim jcnt As Integer
Dim Info2 As Variant
Dim iRow1 As Integer
'Dim InfoDoc2 As Variant
On Error GoTo ErrHandler
iErrCode = 0
Set objContext = GetObjectContext()
Set catDB = New ADOX.Catalog
Set tblList = New ADOX.Table
Set sCol = New ADOX.Column
Set sKey = New ADOX.Key
Set sInd = New ADOX.Index
iErrCode = 0
Set catDB = New ADOX.Catalog
catDB.ActiveConnection = sConnect
iRow1 = iRow1 + 1
Set Info2 = infodoc2.createNode(1, "Table_Columns" & iRow1, "")
infodoc2.documentElement.appendChild (Info2)
For Each
If tblList.Type = "TABLE" Then
If LCase(Trim(tblList.Name)) = LCase(Trim(stable)) Then
For Each sCol In tblList.Columns
jcnt = jcnt + 1
Set Info2 = infodoc2.createNode(1, "Row" & jcnt, "")
'InfoDoc2.documentElement.childNodes(iRow1 - 1).appendChild (Info2)
infodoc2.documentElement.childNodes(infodoc2.docum entElement.childNodes.length - 1).appendChild (Info2)
Info2.setAttribute "TABLE_NAME", tblList.Name
Info2.setAttribute "COLUMN_NAME", sCol.Name
Info2.setAttribute "TYPE_NAME", sCol.Type
Select Case sCol.Type
Case 2
Info2.setAttribute "TYPE_NAME", "smallint"
Info2.setAttribute "LENGTH", 2
Case 3
Info2.setAttribute "TYPE_NAME", "int"
Info2.setAttribute "LENGTH", 4
Case 4
Info2.setAttribute "TYPE_NAME", "real"
Info2.setAttribute "LENGTH", 4
Case 5
Info2.setAttribute "TYPE_NAME", "float"
Info2.setAttribute "LENGTH", 8
Case 6
Info2.setAttribute "TYPE_NAME", "money"
Info2.setAttribute "LENGTH", 8
Case 11
Info2.setAttribute "TYPE_NAME", "bit"
Info2.setAttribute "LENGTH", 1
Case 17
Info2.setAttribute "TYPE_NAME", "tinyint"
Info2.setAttribute "LENGTH", 1
Case 20
Info2.setAttribute "TYPE_NAME", "bigint"
Info2.setAttribute "LENGTH", 20
Case 72
Info2.setAttribute "TYPE_NAME", "uniqueidentifier"
Info2.setAttribute "LENGTH", 16
Case 128
Info2.setAttribute "TYPE_NAME", "binary"
Info2.setAttribute "LENGTH", sCol.DefinedSize
Case 129
Info2.setAttribute "TYPE_NAME", "char"
Info2.setAttribute "LENGTH", sCol.DefinedSize
Case 130
Info2.setAttribute "TYPE_NAME", "nchar"
Info2.setAttribute "LENGTH", sCol.DefinedSize
Case 131
Info2.setAttribute "TYPE_NAME", "decimal"
Info2.setAttribute "LENGTH", 9
Case 135
Info2.setAttribute "TYPE_NAME", "datetime"
Info2.setAttribute "LENGTH", 8
Case 200
Info2.setAttribute "TYPE_NAME", "varchar"
Info2.setAttribute "LENGTH", sCol.DefinedSize
Case 201
Info2.setAttribute "TYPE_NAME", "text"
Info2.setAttribute "LENGTH", 16
Case 202
Info2.setAttribute "TYPE_NAME", "nvarchar"
Info2.setAttribute "LENGTH", sCol.DefinedSize
Case 203
Info2.setAttribute "TYPE_NAME", "ntext"
Info2.setAttribute "LENGTH", 16
Case 204
Info2.setAttribute "TYPE_NAME", "varbinary"
Info2.setAttribute "LENGTH", sCol.DefinedSize
Case 205
Info2.setAttribute "TYPE_NAME", "image"
Info2.setAttribute "LENGTH", 16
End Select
Next
For Each sInd In tblList.Indexes
For Each sCol In sInd.Columns
If sInd.PrimaryKey = True Then
jcnt = jcnt + 1
Set Info2 = infodoc2.createNode(1, "Row" & jcnt, "")
'InfoDoc2.documentElement.childNodes(iRow1 - 1).appendChild (Info2)
infodoc2.documentElement.childNodes(infodoc2.docum entElement.childNodes.length - 1).appendChild (Info2)
Info2.setAttribute "TABLE_NAME", tblList.Name
Info2.setAttribute "COLUMN_NAME", sCol.Name
End If
Next
Next
Exit For
End If
End If
Next
sFields = infodoc2.xml
If iErrCode = 0 Then
ListFields = True
If Not (objContext Is Nothing) Then
objContext.SetComplete
End If
Else
ListFields = False
If Not (objContext Is Nothing) Then
objContext.SetAbort
End If
End If
Set catDB = Nothing
Set tblList = Nothing
Set sCol = Nothing
Set sKey = Nothing
Set sInd = Nothing
Set objContext = Nothing
Exit Function
ErrHandler:
iErrCode = 1
sErrMsg = Err.Description
ListFields = False
If Not (objContext Is Nothing) Then
objContext.SetAbort
End If
Set catDB = Nothing
Set tblList = Nothing
Set sCol = Nothing
Set sKey = Nothing
Set sInd = Nothing
Set objContext = Nothing
End Function