Sub WriteFieldsInfoToRange(db As ADODB.Connection, startCell As Range, Optional tableName As String = vbNullString)
'Description: Writes name and other info of all fields of all or one selected table
Dim adoRecSet As ADODB.Recordset
Dim i As Long
Dim j As Long
' if startCell consists of more then one cell then upper-left is used
If startCell.Cells.Count > 1 Then startCell = startCell.Cells(1)
Select Case tableName
Case vbNullString 'no table name given -> output all tables
Set adoRecSet = db.OpenSchema(adSchemaColumns)
Case Else
Set adoRecSet = db.OpenSchema(adSchemaColumns, Array(Empty, Empty, tableName, Empty))
End Select
i = 0
With adoRecSet
For j = 0 To .Fields.Count - 1
startCell.Offset(i, j) = .Fields(j).Name
Next j
i = 1
.MoveFirst
Do While Not .EOF
For j = 0 To .Fields.Count - 1
startCell.Offset(i, j) = .Fields(j).Value
Next j
.MoveNext
i = i + 1
Loop
.Close
End With
Set adoRecSet = Nothing
End Sub