Know list database and table in SQL Server

I use this macro to list in A column of sheet the name of sql server on
my lan.
Is possible to "scan server by server" and insert into column B the
name of database and related table?
Tks.
Sub test_sql()
Dim TEST As String
Dim RIGA As String

Set sqlApp = CreateObject("SQLDMO.Application")

Set serverList = sqlApp.ListAvailableSQLServers

numServers = serverList.Count
RIGA = 2

For I = 1 To numServers

TEST = serverList(I)

Range("A" + RIGA) = TEST
RIGA = RIGA + 1
Next

Set sqlApp = Nothing

End Subsorry for UP...|||Give this a try - the code assumes that you can connect to each server via Windows Authentication and that you have appropriate permissions to list the databases/tables. I've added Error handling for the connection to each server - if there is a problem listing the databases/tables, the code will stop with an error. Please note that I haven't performed any extensive testing of the code.

Sub SQLAudit()
'Clear sheet
Cells.ClearContents
Cells.ClearFormats

Const DisplaySystemDatabases = False ' Change this if you want to view system databases
Const DisplaySystemTables = False ' change this if you want to view system tables
Dim objSQLApp, objSQLServer, objSQLDatabase, objSQLTable
Dim strSQLServer
Dim i As Integer
i = 1

Set objSQLApp = CreateObject("SQLDMO.Application")

' Enumerate list of available SQL Servers
For Each strSQLServer In objSQLApp.ListAvailableSQLServers
' Server Header (Remove if header not required)
Range("A" & i).Value = strSQLServer
Range("A" & i & ":C" & i).Merge
Range("A" & i & ":C" & i).Font.Bold = True
Range("A" & i & ":C" & i).Font.Size = 14
Range("A" & i & ":C" & i).HorizontalAlignment = xlCenter
i = i + 1
' ***********************
Set objSQLServer = CreateObject("SQLDMO.SQLServer")
objSQLServer.LoginSecure = True ' Connect using Windows Authentication
On Error Resume Next
' Connect to the server (will fail if user does not have logon for server)
objSQLServer.Connect strSQLServer
If Err.Number <> 0 Then
' Display a message if unable to connect to the server
MsgBox ("Failed to connect to: " & strSQLServer & vbCrLf & Err.Description)
Err.Clear
Else
On Error GoTo 0 ' Turn off resume next error handling (throw exception if error occurs)
' Enumerate databases on server
For Each objSQLDatabase In objSQLServer.Databases
If (Not objSQLDatabase.SystemObject) Or DisplaySystemDatabases Then
' Database Header (Remove if header not requied)
Range("B" & i).Value = objSQLDatabase.Name
Range("B" & i & ":C" & i).Merge
Range("B" & i & ":C" & i).Font.Bold = True
Range("B" & i & ":C" & i).HorizontalAlignment = xlCenter
i = i + 1
' ***********************
'Enumerate tables in database
For Each objSQLTable In objSQLDatabase.Tables
If (Not objSQLTable.SystemObject) Or DisplaySystemTables Then
Range("A" & i).Value = objSQLServer.Name
Range("B" & i).Value = objSQLDatabase.Name
Range("C" & i).Value = objSQLTable.Name
i = i + 1
End If
Next
End If
Next
End If
Next

Set objSQLApp = Nothing
Set objSQLServer = Nothing
Set objSQLDatabase = Nothing
Set objSQLTable = Nothing
End Sub