Sub WriteTablesInfoToRange(objConn As ADODB.Connection, startCell As Range)
'Description: Writes table and query (View) names and other info to a range
'Inputs: Connection object; start cell (Range)
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)
Set adoRecSet = objConn.OpenSchema(adSchemaTables) ', Array(Empty, Empty, Empty, "TABLE")
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