Option Explicit

' Obs: Referenser i projektet:
'
' Microsoft ActiveX Data Objects 2.6 Library
' Microsoft ADO Ext. 2.6 for DDL and Security
'
Private Sub Command1_Click()
Dim app_path As String
Dim db_file As String
Dim conn As ADODB.Connection
Dim adox_catalog As ADOX.Catalog
Dim adox_table As ADOX.Table
Dim rs As ADODB.Recordset
Dim i As Integer
Dim txt As String

app_path = App.Path
If Right$(app_path, 1) <> "\" Then app_path = app_path & "\"

' öppna första databasen.
db_file = app_path & "Depts.mdb"
Set conn = New ADODB.Connection
conn.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & db_file & ";" & _
"Persist Security Info=False"
conn.Open

' Skapa en länk till tabellen Employees
' i Emp databasen.
Set adox_catalog = New ADOX.Catalog
Set adox_catalog.ActiveConnection = conn

Set adox_table = New ADOX.Table
With adox_table
Set .ParentCatalog = adox_catalog
.Name = "LinkedTable"
.Properties("Jet OLEDB:Link Datasource") = app_path & "Emps.mdb"
.Properties("Jet OLEDB:Link Provider String") = "MS Access"
.Properties("Jet OLEDB:Remote Table Name") = "Employees"
.Properties("Jet OLEDB:Create Link") = True
End With

' Addera tabellen till table collection.
adox_catalog.Tables.Append adox_table

' Kör join-frågan.
Set rs = conn.Execute( _
"SELECT * " & _
"FROM Departments, LinkedTable " & _
"WHERE Departments.DepartmentId = LinkedTable.DepartmentId", , _
adCmdText)

' Visa resultatet.
Do While Not rs.EOF
txt = txt & rs.Fields(0).Value
For i = 1 To rs.Fields.Count - 1
txt = txt & ", " & rs.Fields(i).Value
Next i
txt = txt & vbCrLf

rs.MoveNext
Loop
rs.Close
txtResults.Text = txt

' Radera den länkade tabellen.
adox_catalog.Tables.Delete "LinkedTable"

' Stäng databasen.
conn.Close
End Sub