Sub ConnectX()
Dim dbsTemp As Database
Dim strMenu As String
Dim strInput As String
' Open a Microsoft Access database to which you will link
' a table.
Set dbsTemp = OpenDatabase("DB1.mdb")
' Build menu text.
strMenu = "Enter number for data source:" & vbCr
strMenu = strMenu & _
" 1. Microsoft Access database" & vbCr
strMenu = strMenu & _
" 2. Microsoft FoxPro 3.0 table" & vbCr
strMenu = strMenu & _
" 3. dBASE table" & vbCr
strMenu = strMenu & _
" 4. Paradox table" & vbCr
strMenu = strMenu & _
" M. (see choices 5-9)"
' Get user's choice.
strInput = InputBox(strMenu)
If UCase(strInput) = "M" Then
' Build menu text.
strMenu = "Enter number for data source:" & vbCr
strMenu = strMenu & _
" 5. Microsoft Excel spreadsheet" & vbCr
strMenu = strMenu & _
" 6. Lotus spreadsheet" & vbCr
strMenu = strMenu & _
" 7. Comma-delimited text (CSV)" & vbCr
strMenu = strMenu & _
" 8. HTML table" & vbCr
strMenu = strMenu & _
" 9. Microsoft Exchange folder"
' Get user's choice.
strInput = InputBox(strMenu)
End If
' Call the ConnectOutput procedure. The third argument
' will be used as the Connect string, and the fourth
' argument will be used as the SourceTableName.
Select Case Val(strInput)
Case 1
ConnectOutput dbsTemp, _
"AccessTable", _
";DATABASE=C:\My Documents\Northwind.mdb", _
"Employees"
Case 2
ConnectOutput dbsTemp, _
"FoxProTable", _
"FoxPro 3.0;DATABASE=C:\FoxPro30\Samples", _
"Q1Sales"
Case 3
ConnectOutput dbsTemp, _
"dBASETable", _
"dBase IV;DATABASE=C:\dBASE\Samples", _
"Accounts"
Case 4
ConnectOutput dbsTemp, _
"ParadoxTable", _
"Paradox 3.X;DATABASE=C:\Paradox\Samples", _
"Accounts"
Case 5
ConnectOutput dbsTemp, _
"ExcelTable", _
"Excel 5.0;" & _
"DATABASE=C:\Excel\Samples\Q1Sales.xls", _
"January Sales"
Case 6
ConnectOutput dbsTemp, _
"LotusTable", _
"Lotus WK3;" & _
"DATABASE=C:\Lotus\Samples\Sales.xls", _
"THIRDQTR"
Case 7
ConnectOutput dbsTemp, _
"CSVTable", _
"Text;DATABASE=C:\Samples", _
"Sample.txt"
Case 8
ConnectOutput dbsTemp, _
"HTMLTable", _
"HTML Import;DATABASE=http://" & _
"www.server1.com/samples/page1.html", _
"Q1SalesData"
Case 9
ConnectOutput dbsTemp, _
"ExchangeTable", _
"Exchange 4.0;MAPILEVEL=" & _
"Mailbox - Michelle Wortman (Exchange)" & _
"|People\Important;", _
"Jerry Wheeler"
End Select
dbsTemp.Close
End Sub
Sub ConnectOutput(dbsTemp As Database, _
strTable As String, strConnect As String, _
strSourceTable As String)
Dim tdfLinked As TableDef
Dim rstLinked As Recordset
Dim intTemp As Integer
' Create a new TableDef, set its Connect and
' SourceTableName properties based on the passed
' arguments, and append it to the TableDefs collection.
Set tdfLinked = dbsTemp.CreateTableDef(strTable)
tdfLinked.Connect = strConnect
tdfLinked.SourceTableName = strSourceTable
dbsTemp.TableDefs.Append tdfLinked
Set rstLinked = dbsTemp.OpenRecordset(strTable)
Debug.Print "Data from linked table:"
' Display the first three records of the linked table.
intTemp = 1
With rstLinked
Do While Not .EOF And intTemp <= 3
Debug.Print , .Fields(0), .Fields(1)
intTemp = intTemp + 1
.MoveNext
Loop
If Not .EOF Then Debug.Print , "[additional records]"
.Close
End With
' Delete the linked table because this is a demonstration.
dbsTemp.TableDefs.Delete strTable
End Sub