[原创]从MDB更新链接表到SQL SERVER

secowu

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'2005-08-18   中俄双雄演义日

'By 狠狠活

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function AddLinkedTablesLooper()

Dim sConnString As String

Dim rs1 As New ADODB.Recordset

Dim tabName As String



' 创建一个新的表对象

Set rs1 = GetSqlServerTables

rs1.MoveFirst

tabName = rs1!Name



While Not rs1.EOF

    Call AddSQLServerLinkedTables(tabName)

    rs1.MoveNext

    tabName = rs1!Name

Wend



Set rs1 = Nothing



End Function



Public Function GetSqlServerTables() As ADODB.Recordset

    Dim cn As New ADODB.Connection, sql1 As String

    Dim rs As New ADODB.Recordset, connString As String

    Dim Myarr(50) As String, indx As Integer, maxindx As Integer

    connString = "provider=SQLOLEDB.1;" & _

            "User ID=sa;Initial Catalog=northwind;" & _

            "Data Source=localhost;" & _

            "ersist Security Info=False"



    ''Set cn = CurrentProject.Connection

    cn.ConnectionString = connString

    cn.Open

    sql1 = "select name from dbo.sysobjects where xtype = 'U'"

   

    rs.Open sql1, cn, adOpenStatic, adLockReadOnly

   

    If rs.EOF And rs.BOF Then

        MsgBox "No sql server tables returned"

        Set rs = Nothing

        Exit Function

    End If

   

    rs.MoveFirst

    indx = 0

    While Not rs.EOF

        Myarr(indx) = rs!Name

        indx = indx + 1

        rs.MoveNext

    Wend

    maxindx = indx - 1

    For indx = 0 To maxindx

        Debug.Print "table name = "; Myarr(indx)

    Next

    Set GetSqlServerTables = rs

    Set rs = Nothing

End Function



Public Function AddSQLServerLinkedTables(tabName As String)

Dim oCat As ADOX.Catalog

Dim oTable As ADOX.Table

Dim sConnString As String

On Error GoTo Errhandler

' 将 SQL Server 转接到这些链接表.

sConnString = "ODBC;" & _

               "Driver={SQL Server};" & _

               "Server={localhost};" & _

               "Database=Northwind;" & _

               "Uid=sa;" & _

               "wd=;"



' 创建并打开 ADOX ，并连接到 Access 数据库

Set oCat = New ADOX.Catalog

oCat.ActiveConnection = CurrentProject.Connection





Set oTable = New ADOX.Table



Set oTable.ParentCatalog = oCat



With oTable

    Debug.Print "loop = "; tabName

    .Name = "NW_" & tabName

    .Properties("Jet OLEDB:Create Link") = True

    .Properties("Jet OLEDB:Remote Table Name") = tabName

    .Properties("Jet OLEDBink Provider String") = sConnString

End With

' 将表对象添加到数据库

oCat.Tables.Append oTable

oCat.Tables.Refresh



Set oCat = Nothing

Set oTable = Nothing

Exit Function



Errhandler:

Dim er As ADODB.Error

Debug.Print " In Error Handler "; Err.description & vbCrLf

For Each er In CurrentProject.Connection.Errors

    Debug.Print "err num = "; Err.Number

    Debug.Print "err desc = "; Err.description

    Debug.Print "err source = "; Err.Source

    Debug.Print "connection state = "; CurrentProject.Connection.state

Next



End Function

[此贴子已经被作者于2005-8-18 13:34:34编辑过]

wu8313

能介绍一下怎么用吗？代码不是很理解。