I think this will get you close; I don't have an SQL Server I can test against. Add Microsoft ActiveX Data Objects to references in Tools
Private Sub btnCopyTables_Click()
' we will need to create this table using DAO
Dim tdf As DAO.TableDef
Dim sqlUserTablesRS As ADODB.Recordset
Dim sqlConn As ADODB.Connection
Dim connectionString As String
Dim tableName As String
Dim tablePrimaryKey As String
Dim SQL As String
' set the connection string
'strConnectionString = "ODBC;DRIVER=SQL Server; SERVER=.\SQLExpress;DATABASE=MyDatabase;Trusted_Connection=Yes"
connectionString = "Provider=SQLOLEDB;Data Source=.\SQLExpress;DATABASE=MyDatabase;Trusted_Connection=Yes;Connect Timeout=15"
Set sqlConn = New ADODB.Connection
Set sqlUserTablesRS = New ADODB.Recordset
' connect to SQL Server and retrieve the user tables
sqlConn.Open (connectionString)
' retrieves the tables and their primary indexes from the sql server
SQL = "select "
SQL = SQL & " s.name as SchemaName, "
SQL = SQL & " t.name as TableName, "
SQL = SQL & " tc.name as ColumnName, "
SQL = SQL & " ic.key_ordinal as KeyOrderNr "
SQL = SQL & "from "
SQL = SQL & " sys.schemas s "
SQL = SQL & " inner join sys.tables t on s.schema_id=t.schema_id "
SQL = SQL & " inner join sys.indexes i on t.object_id=i.object_id "
SQL = SQL & " inner join sys.index_columns ic on i.object_id=ic.object_id and i.index_id=ic.index_id "
SQL = SQL & " inner join sys.columns tc on ic.object_id=tc.object_id and ic.column_id=tc.column_id "
SQL = SQL & "where i.is_primary_key=1 "
SQL = SQL & "order by t.name, ic.key_ordinal ;"
sqlUserTablesRS.Open SQL, sqlConn
' loop through the tables and add them to access using the same names
Do While Not sqlUserTablesRS.EOF
tableName = sqlUserTablesRS("TableName")
tablePrimaryKey = sqlUserTablesRS("ColumnName")
On Error Resume Next
' remove it if it exists in this database
DoCmd.RunSQL "drop table " & tableName
On Error GoTo 0
Set tdf = CurrentDb.CreateTableDef(tableName)
tdf.Connect = strConnectionString
tdf.SourceTableName = tableName
CurrentDb.TableDefs.Append tdf
Set tdf = Nothing
On Error Resume Next
DoCmd.RunSQL "CREATE UNIQUE INDEX UniqueIndex ON " & tableName & " (" & tablePrimaryKey & ")"
On Error GoTo 0
sqlUserTablesRS.MoveNext
Loop
sqlUserTablesRS.Close
Set sqlUserTablesRS = Nothing
sqlConn.Close
Set sqlConn = Nothing
End Sub
EDIT: copied the wrong SQL statement for the table/index list