Function Describe(tblName As String) As String
Const CN_STRING As String = "ODBC;Your connection string"
Const PIPE As String = "|"
' Const adCmdText As Integer = 1, _
' adClipString As Integer = 2
Dim SQL_DESCRIBE As String, _
ret As String, _
i As Integer
SQL_DESCRIBE = _
"SELECT " & vbNewLine & _
" a.[NAME] AS [Field], " & vbNewLine & _
" a.[TYPE] AS [Type], " & vbNewLine & _
" a.[NULL] AS [Null], " & vbNewLine & _
" a.[KEY] AS [Key], " & vbNewLine & _
" a.[DEFAULT] AS [Default], " & vbNewLine & _
" CONCAT_WS(' ', a.[IDENTITY], b.[COMMENTS]) AS [Extra] " & vbNewLine & _
"FROM ( " & vbNewLine & _
" SELECT " & vbNewLine & _
" sc.COLUMN_NAME AS [NAME], " & vbNewLine & _
" Case sc.DATA_TYPE " & vbNewLine & _
" WHEN 'char' THEN UPPER(sc.DATA_TYPE) + '(' + CAST(sc.CHARACTER_MAXIMUM_LENGTH AS VARCHAR) + ')' " & vbNewLine & _
" WHEN 'numeric' THEN UPPER(sc.DATA_TYPE) + '(' + CAST(sc.NUMERIC_PRECISION AS VARCHAR) + ', ' + CAST(sc.NUMERIC_SCALE AS VARCHAR) + ')' " & vbNewLine & _
" WHEN 'decimal' THEN UPPER(sc.DATA_TYPE) + '(' + CAST(sc.NUMERIC_PRECISION AS VARCHAR) + ', ' + CAST(sc.NUMERIC_SCALE AS VARCHAR) + ')' " & vbNewLine & _
" WHEN 'nvarchar' THEN UPPER(sc.DATA_TYPE) + '(' + IIF(sc.CHARACTER_MAXIMUM_LENGTH < 0, 'MAX', CAST(sc.CHARACTER_MAXIMUM_LENGTH AS VARCHAR)) + ')' " & vbNewLine & _
" WHEN 'varbinary' THEN UPPER(sc.DATA_TYPE) + '(' + CAST(sc.CHARACTER_MAXIMUM_LENGTH AS VARCHAR) + ')' " & vbNewLine & _
" WHEN 'varchar' THEN UPPER(sc.DATA_TYPE) + '(' + CAST(sc.CHARACTER_MAXIMUM_LENGTH AS VARCHAR) + ')' " & vbNewLine & _
" ELSE UPPER(sc.DATA_TYPE) " & vbNewLine & _
" END AS [TYPE], " & vbNewLine & _
" sc.IS_NULLABLE AS [NULL], " & vbNewLine & _
" k.CONSTRAINT_TYPE AS [KEY], " & vbNewLine
SQL_DESCRIBE = SQL_DESCRIBE & _
" CASE " & vbNewLine & _
" WHEN sc.COLUMN_DEFAULT IS NOT NULL AND LEN(sc.COLUMN_DEFAULT) > 2 THEN " & vbNewLine & _
" CASE " & vbNewLine & _
" WHEN LEFT(sc.COLUMN_DEFAULT, 2) = '((' THEN SUBSTRING(sc.COLUMN_DEFAULT, 3, LEN(sc.COLUMN_DEFAULT) - 4) " & vbNewLine & _
" ELSE SUBSTRING(sc.COLUMN_DEFAULT, 2, LEN(sc.COLUMN_DEFAULT) - 2) " & vbNewLine & _
" END " & vbNewLine & _
" ELSE sc.COLUMN_DEFAULT " & vbNewLine & _
" END AS [DEFAULT], " & vbNewLine & _
" CASE " & vbNewLine & _
" WHEN CAST(COLUMNPROPERTY(OBJECT_ID(sc.TABLE_NAME), sc.COLUMN_NAME, 'IsIdentity') AS BIT) = 1 THEN 'AUTO_INCREMENT' " & vbNewLine & _
" ELSE NULL " & vbNewLine & _
" END AS [IDENTITY], " & vbNewLine & _
" sc.ORDINAL_POSITION " & vbNewLine & _
" FROM INFORMATION_SCHEMA.COLUMNS sc " & vbNewLine & _
" LEFT JOIN ( " & vbNewLine & _
" SELECT " & vbNewLine & _
" u.TABLE_SCHEMA, " & vbNewLine & _
" u.TABLE_NAME, " & vbNewLine & _
" u.COLUMN_NAME, " & vbNewLine & _
" tc.CONSTRAINT_TYPE " & vbNewLine & _
" FROM INFORMATION_SCHEMA.KEY_COLUMN_USAGE u " & vbNewLine & _
" INNER JOIN INFORMATION_SCHEMA.TABLE_CONSTRAINTS tc " & vbNewLine & _
" ON u.TABLE_SCHEMA = tc.CONSTRAINT_SCHEMA " & vbNewLine
SQL_DESCRIBE = SQL_DESCRIBE & _
" AND u.TABLE_NAME = tc.TABLE_NAME " & vbNewLine & _
" AND u.CONSTRAINT_NAME = tc.CONSTRAINT_NAME " & vbNewLine & _
" ) k " & vbNewLine & _
" ON sc.TABLE_SCHEMA = k.TABLE_SCHEMA " & vbNewLine & _
" AND sc.TABLE_NAME = k.TABLE_NAME " & vbNewLine & _
" AND sc.COLUMN_NAME = k.COLUMN_NAME " & vbNewLine & _
" WHERE sc.TABLE_NAME = @objectName " & vbNewLine & _
") a " & vbNewLine & _
"FULL JOIN ( " & vbNewLine & _
" SELECT " & vbNewLine & _
" CAST(value AS NVARCHAR) AS [COMMENTS], " & vbNewLine & _
" CAST(objname AS NVARCHAR) AS [NAME] " & vbNewLine & _
" FROM ::fn_listextendedproperty ('MS_Description', 'user', 'dbo', 'table', @objectName, 'column', default) " & vbNewLine & _
") b " & vbNewLine & _
" ON a.NAME COLLATE DATABASE_DEFAULT = b.NAME COLLATE DATABASE_DEFAULT " & vbNewLine & _
"ORDER BY " & vbNewLine & _
" a.ORDINAL_POSITION;"
SQL_DESCRIBE = Replace(SQL_DESCRIBE, "@objectName", "'" & tblName & "'")
With CreateObject("ADODB.Connection")
.ConnectionString = CN_STRING
.Open
With .Execute(SQL_DESCRIBE, , adCmdText)
If Not .EOF Then
For i = 0 To .Fields.Count - 1
ret = ret & PIPE & .Fields(i).Name
Next i
ret = Mid(ret, Len(PIPE) + 1) & vbNewLine
ret = ret & .GetString(adClipString, , PIPE)
Else
ret = "No table with name " & tblName & " found on server"
End If
.Close
End With
.Close
End With
Describe = ret
End Function
