程式設計管理(新增、刪除、重新整理) Access 連結表資訊 (轉)

程式設計管理(新增、刪除、重新整理) Access 連結表資訊 (轉)[@more@]

'首先 , 作如下測試工作:
'新建空白 Access (.m) ,
'並新增若干型別連結表:
'se 5 (*.dbf)、
' (*.xls)、
'Microsoft Access (*.mdb;*.mda;*.mde) 等,
'然後再編寫如下 :
'、等程式同理也可:
'引用 Microsoft Data s 2.x Library
'引用 Microsoft ADO Ext. 2.x for DDL and Security
': Form1、Command1、Command2、Command3
Private Sub Command1_Click() '測試連結表資訊
Dim adoConnection As New ADODB.Connection
adoConnection.Open "Provr=Microsoft.Jet.OLEDB.4.0;Data =E:LnkTbls.mdb;Persist Security Info=False;Jet OLEDB:Database Pass=123"
Dim adoCatalog As New ADOX.Catalog
Set adoCatalog.ActiveConnection = adoConnection
Dim adoTable As New ADOX.Table
Set adoTable.ParentCatalog = adoCatalog
Dim i As Integer
For Each adoTable In adoCatalog.Tables
  If adoTable.Type = "LINK" Then
  De.Print adoTable.Name
  For i = 0 To adoTable.Properties.Count - 1
  Debug.Print "  " & adoTable.Properties.Item(i).Name & ": " & adoTable.Properties.Item(i).Value
  Next i
  Debug.Print VBA.vbCrLf
  End If
Next adoTable
End Sub
'新增連結表
Private Sub Command2_Click()
Dim adoConnection As New ADODB.Connection
adoConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:LnkTbls.mdb;Persist Security Info=False;Jet OLEDB:Database Password=123"
Dim adoCatalog As New ADOX.Catalog
Dim adoTable As New ADOX.Table

'Access
Set adoCatalog.ActiveConnection = adoConnection
Set adoTable.ParentCatalog = adoCatalog
adoTable.Properties.Item("Jet OLEDB:Link Datasource").Value = "e:nwind2kpwd.mdb"
adoTable.Properties.Item("Jet OLEDB:Remote Table Name").Value = "產品"
adoTable.Properties.Item("Jet OLEDB:Create Link").Value = True
adoTable.Properties.Item("Jet OLEDB:Link Provider String").Value = "MS Access;Pwd=456"
adoTable.Name = "Access"
adoCatalog.Tables.Append adoTable
adoConnection.Close

'dBase
adoConnection.Open
Set adoCatalog.ActiveConnection = adoConnection
Set adoTable.ParentCatalog = adoCatalog
adoTable.Properties.Item("Jet OLEDB:Link Datasource").Value = "E:BorlandSharedData"
adoTable.Properties.Item("Jet OLEDB:Remote Table Name").Value = "animals#dbf"
adoTable.Properties.Item("Jet OLEDB:Create Link").Value = True
adoTable.Properties.Item("Jet OLEDB:Link Provider String").Value = "dBase 5.0"
adoTable.Name = "dBase5"
adoCatalog.Tables.Append adoTable
adoConnection.Close

'Excel
adoConnection.Open
Set adoCatalog.ActiveConnection = adoConnection
Set adoTable.ParentCatalog = adoCatalog
adoTable.Properties.Item("Jet OLEDB:Link Datasource").Value = "E:Book97.xls"
adoTable.Properties.Item("Jet OLEDB:Remote Table Name").Value = "Sheet1$"
adoTable.Properties.Item("Jet OLEDB:Create Link").Value = True
adoTable.Properties.Item("Jet OLEDB:Link Provider String").Value = "Excel 5.0;HDR=NO;IMEX=2"
adoTable.Name = "Excel"
adoCatalog.Tables.Append adoTable
adoConnection.Close
'...
End Sub
'程式設計刪除連結表
Private Sub Command3_Click()
Dim adoConnection As New ADODB.Connection
adoConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:LnkTbls.mdb;Persist Security Info=False;Jet OLEDB:Database Password=123"
Dim adoCatalog As New ADOX.Catalog
Set adoCatalog.ActiveConnection = adoConnection
Dim j As Integer
Dim i As Integer
For i = adoCatalog.Tables.Count To 1 Step -1
  If adoCatalog.Tables.Item(i - 1).Type = "LINK" Then
  Debug.Print adoCatalog.Tables.Item(i - 1).Name
  For j = 0 To adoCatalog.Tables.Item(i - 1).Properties.Count - 1
  Debug.Print "  " & adoCatalog.Tables.Item(i - 1).Properties.Item(j).Name & ": " & adoCatalog.Tables.Item(i - 1).Properties.Item(j).Value
  Next j
  Debug.Print VBA.vbCrLf
  If VBA.MsgBox("Delete link table [" & adoCatalog.Tables.Item(i - 1).Name & "]?", vbYesNo) Then
  adoCatalog.Tables.Delete adoCatalog.Tables.Item(i - 1).Name
  End If
  End If
Next i
End Sub

Private Sub Command4_Click()
Dim adoConnection As New ADODB.Connection
adoConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:LnkTbls.mdb;Persist Security Info=False;Jet OLEDB:Database Password=123"
Dim adoCatalog As New ADOX.Catalog
Set adoCatalog.ActiveConnection = adoConnection
adoCatalog.Tables.Item("Excel").Properties.Item("Jet OLEDB:Link Provider String").Value = "Excel 5.0;HDR=yes;IMEX=2"
End Sub

Private Sub Form_Load()
Command1.Caption = "連結表資訊"
Command2.Caption = "新增連結表"
Command3.Caption = "刪除連結表"
Command4.Caption = "重新整理連結表"
End Sub