在您的MDB里瞬间断开或链接后台表（防止病毒扩散哦）

secowu

'将此代码粘贴在点击事件里

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

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

'By 狠狠活

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



Private Sub cmbDelete_Click()

LinksDelete

End Sub

'此断开链接'''''''''''''''''''''''''''''''''''''''''''''''''



'开启链接

Private Sub cmbLink_Network_Click()



Dim sNewLink As String

  ' ReLink the data files to network locations

  ' Need to set up the strings

sNewLink = "ath of tables you are linking"

Call LinksCreateToSource(sNewLink)

End Sub

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







'将下面代码粘贴在模块里



Public Sub LinksCreateToSource(strLinkSourceDB As String, Optional prpProgressBar As Object)

On Error GoTo Err_LinksCreateToSource

    Dim dbs As Database

    Dim tdf As TableDef

    Dim TdfCount As Long

    Dim i As Long

   

    '打开 DB 源

    Set dbs = DBEngine.Workspaces(0).OpenDatabase(strLinkSourceDB)

    '计算链接表数目

        For Each tdf In dbs.TableDefs

        If Left(tdf.name, 4) <> "MSys" Then 'Do not link to the System tables

            TdfCount = TdfCount + 1

        End If

    Next tdf

      If Not prpProgressBar Is Nothing Then

        prpProgressBar.Max = TdfCount

        prpProgressBar.Visible = True

    End If

    '检测所有链接表

    For Each tdf In dbs.TableDefs

        If Left(tdf.name, 4) <> "MSys" Then  'Do not link to the System tables

            

            i = i + 1

            If Not prpProgressBar Is Nothing Then

                prpProgressBar.Value = i

            End If

            '创建链接

            DoCmd.TransferDatabase acLink, _

                "Microsoft Access", strLinkSourceDB, acTable, tdf.name, tdf.name

        End If

    Next tdf

    dbs.Close

    Set dbs = Nothing

       If Not prpProgressBar Is Nothing Then

        prpProgressBar.Visible = False

    End If

   

Exit_LinksCreateToSource:

    Exit Sub

   

Err_LinksCreateToSource:

    MsgBox "Error No " & Err.Number & vbLf & Error$, , "Sub LinksCreateToSource"

    Stop

    Resume Exit_LinksCreateToSource

   

End Sub



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

'断开链接表



Public Sub LinksDelete(Optional strConnectString As String = "")



    Dim tdf As TableDef

   

    For Each tdf In CurrentDb.TableDefs

        If tdf.Connect <> "" Then 'Check for linked tables

      

            If InStr(1, tdf.Connect, strConnectString, vbTextCompare) > 0 Then

               

                DoCmd.DeleteObject acTable, tdf.name

            End If

        End If

    Next tdf

End Sub

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

wjb5645

能改改用于链接SQL的吗?