Public Function ListFields(sCon nect 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.Obje ctContext
Dim jcnt As Integer
Dim Info2 As Variant
Dim iRow1 As Integer
'Dim InfoDoc2 As Variant
On Error GoTo ErrHandler
iErrCode = 0
Set objContext = GetObjectContex t()
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.ActiveCon nection = sConnect
iRow1 = iRow1 + 1
Set Info2 = infodoc2.create Node(1, "Table_Colu mns" & iRow1, "")
infodoc2.docume ntElement.appen dChild (Info2)
For Each
If tblList.Type = "TABLE" Then
If LCase(Trim(tblL ist.Name)) = LCase(Trim(stab le)) Then
For Each sCol In tblList.Columns
jcnt = jcnt + 1
Set Info2 = infodoc2.create Node(1, "Row" & jcnt, "")
'InfoDoc2.docum entElement.chil dNodes(iRow1 - 1).appendChild (Info2)
infodoc2.docume ntElement.child Nodes(infodoc2. documentElement .childNodes.len gth - 1).appendChild (Info2)
Info2.setAttrib ute "TABLE_NAME ", tblList.Name
Info2.setAttrib ute "COLUMN_NAM E", sCol.Name
Info2.setAttrib ute "TYPE_NAME" , sCol.Type
Select Case sCol.Type
Case 2
Info2.setAttrib ute "TYPE_NAME" , "smallint"
Info2.setAttrib ute "LENGTH", 2
Case 3
Info2.setAttrib ute "TYPE_NAME" , "int"
Info2.setAttrib ute "LENGTH", 4
Case 4
Info2.setAttrib ute "TYPE_NAME" , "real"
Info2.setAttrib ute "LENGTH", 4
Case 5
Info2.setAttrib ute "TYPE_NAME" , "float"
Info2.setAttrib ute "LENGTH", 8
Case 6
Info2.setAttrib ute "TYPE_NAME" , "money"
Info2.setAttrib ute "LENGTH", 8
Case 11
Info2.setAttrib ute "TYPE_NAME" , "bit"
Info2.setAttrib ute "LENGTH", 1
Case 17
Info2.setAttrib ute "TYPE_NAME" , "tinyint"
Info2.setAttrib ute "LENGTH", 1
Case 20
Info2.setAttrib ute "TYPE_NAME" , "bigint"
Info2.setAttrib ute "LENGTH", 20
Case 72
Info2.setAttrib ute "TYPE_NAME" , "uniqueidentifi er"
Info2.setAttrib ute "LENGTH", 16
Case 128
Info2.setAttrib ute "TYPE_NAME" , "binary"
Info2.setAttrib ute "LENGTH", sCol.DefinedSiz e
Case 129
Info2.setAttrib ute "TYPE_NAME" , "char"
Info2.setAttrib ute "LENGTH", sCol.DefinedSiz e
Case 130
Info2.setAttrib ute "TYPE_NAME" , "nchar"
Info2.setAttrib ute "LENGTH", sCol.DefinedSiz e
Case 131
Info2.setAttrib ute "TYPE_NAME" , "decimal"
Info2.setAttrib ute "LENGTH", 9
Case 135
Info2.setAttrib ute "TYPE_NAME" , "datetime"
Info2.setAttrib ute "LENGTH", 8
Case 200
Info2.setAttrib ute "TYPE_NAME" , "varchar"
Info2.setAttrib ute "LENGTH", sCol.DefinedSiz e
Case 201
Info2.setAttrib ute "TYPE_NAME" , "text"
Info2.setAttrib ute "LENGTH", 16
Case 202
Info2.setAttrib ute "TYPE_NAME" , "nvarchar"
Info2.setAttrib ute "LENGTH", sCol.DefinedSiz e
Case 203
Info2.setAttrib ute "TYPE_NAME" , "ntext"
Info2.setAttrib ute "LENGTH", 16
Case 204
Info2.setAttrib ute "TYPE_NAME" , "varbinary"
Info2.setAttrib ute "LENGTH", sCol.DefinedSiz e
Case 205
Info2.setAttrib ute "TYPE_NAME" , "image"
Info2.setAttrib ute "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.create Node(1, "Row" & jcnt, "")
'InfoDoc2.docum entElement.chil dNodes(iRow1 - 1).appendChild (Info2)
infodoc2.docume ntElement.child Nodes(infodoc2. documentElement .childNodes.len gth - 1).appendChild (Info2)
Info2.setAttrib ute "TABLE_NAME ", tblList.Name
Info2.setAttrib ute "COLUMN_NAM E", 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.SetC omplete
End If
Else
ListFields = False
If Not (objContext Is Nothing) Then
objContext.SetA bort
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.SetA bort
End If
Set catDB = Nothing
Set tblList = Nothing
Set sCol = Nothing
Set sKey = Nothing
Set sInd = Nothing
Set objContext = Nothing
End Function
Dim catDB As ADOX.Catalog
Dim sCol As ADOX.Column
Dim sKey As ADOX.Key
Dim sInd As ADOX.Index
Dim objContext As COMSVCSLib.Obje ctContext
Dim jcnt As Integer
Dim Info2 As Variant
Dim iRow1 As Integer
'Dim InfoDoc2 As Variant
On Error GoTo ErrHandler
iErrCode = 0
Set objContext = GetObjectContex t()
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.ActiveCon nection = sConnect
iRow1 = iRow1 + 1
Set Info2 = infodoc2.create Node(1, "Table_Colu mns" & iRow1, "")
infodoc2.docume ntElement.appen dChild (Info2)
For Each
If tblList.Type = "TABLE" Then
If LCase(Trim(tblL ist.Name)) = LCase(Trim(stab le)) Then
For Each sCol In tblList.Columns
jcnt = jcnt + 1
Set Info2 = infodoc2.create Node(1, "Row" & jcnt, "")
'InfoDoc2.docum entElement.chil dNodes(iRow1 - 1).appendChild (Info2)
infodoc2.docume ntElement.child Nodes(infodoc2. documentElement .childNodes.len gth - 1).appendChild (Info2)
Info2.setAttrib ute "TABLE_NAME ", tblList.Name
Info2.setAttrib ute "COLUMN_NAM E", sCol.Name
Info2.setAttrib ute "TYPE_NAME" , sCol.Type
Select Case sCol.Type
Case 2
Info2.setAttrib ute "TYPE_NAME" , "smallint"
Info2.setAttrib ute "LENGTH", 2
Case 3
Info2.setAttrib ute "TYPE_NAME" , "int"
Info2.setAttrib ute "LENGTH", 4
Case 4
Info2.setAttrib ute "TYPE_NAME" , "real"
Info2.setAttrib ute "LENGTH", 4
Case 5
Info2.setAttrib ute "TYPE_NAME" , "float"
Info2.setAttrib ute "LENGTH", 8
Case 6
Info2.setAttrib ute "TYPE_NAME" , "money"
Info2.setAttrib ute "LENGTH", 8
Case 11
Info2.setAttrib ute "TYPE_NAME" , "bit"
Info2.setAttrib ute "LENGTH", 1
Case 17
Info2.setAttrib ute "TYPE_NAME" , "tinyint"
Info2.setAttrib ute "LENGTH", 1
Case 20
Info2.setAttrib ute "TYPE_NAME" , "bigint"
Info2.setAttrib ute "LENGTH", 20
Case 72
Info2.setAttrib ute "TYPE_NAME" , "uniqueidentifi er"
Info2.setAttrib ute "LENGTH", 16
Case 128
Info2.setAttrib ute "TYPE_NAME" , "binary"
Info2.setAttrib ute "LENGTH", sCol.DefinedSiz e
Case 129
Info2.setAttrib ute "TYPE_NAME" , "char"
Info2.setAttrib ute "LENGTH", sCol.DefinedSiz e
Case 130
Info2.setAttrib ute "TYPE_NAME" , "nchar"
Info2.setAttrib ute "LENGTH", sCol.DefinedSiz e
Case 131
Info2.setAttrib ute "TYPE_NAME" , "decimal"
Info2.setAttrib ute "LENGTH", 9
Case 135
Info2.setAttrib ute "TYPE_NAME" , "datetime"
Info2.setAttrib ute "LENGTH", 8
Case 200
Info2.setAttrib ute "TYPE_NAME" , "varchar"
Info2.setAttrib ute "LENGTH", sCol.DefinedSiz e
Case 201
Info2.setAttrib ute "TYPE_NAME" , "text"
Info2.setAttrib ute "LENGTH", 16
Case 202
Info2.setAttrib ute "TYPE_NAME" , "nvarchar"
Info2.setAttrib ute "LENGTH", sCol.DefinedSiz e
Case 203
Info2.setAttrib ute "TYPE_NAME" , "ntext"
Info2.setAttrib ute "LENGTH", 16
Case 204
Info2.setAttrib ute "TYPE_NAME" , "varbinary"
Info2.setAttrib ute "LENGTH", sCol.DefinedSiz e
Case 205
Info2.setAttrib ute "TYPE_NAME" , "image"
Info2.setAttrib ute "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.create Node(1, "Row" & jcnt, "")
'InfoDoc2.docum entElement.chil dNodes(iRow1 - 1).appendChild (Info2)
infodoc2.docume ntElement.child Nodes(infodoc2. documentElement .childNodes.len gth - 1).appendChild (Info2)
Info2.setAttrib ute "TABLE_NAME ", tblList.Name
Info2.setAttrib ute "COLUMN_NAM E", 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.SetC omplete
End If
Else
ListFields = False
If Not (objContext Is Nothing) Then
objContext.SetA bort
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.SetA bort
End If
Set catDB = Nothing
Set tblList = Nothing
Set sCol = Nothing
Set sKey = Nothing
Set sInd = Nothing
Set objContext = Nothing
End Function