[转帖]使用 Microsoft 数据引擎（MSDE）创建和部署 Access 解决方案

zhuyiwen

转自中文MSDN网站

使用 Microsoft 数据引擎创建和部署 Access 解决方案

Scott Smith

Microsoft Corporation

2001 年 4 月



适用于：

   Microsoft® Office XP Developer



摘要：可以使用 Microsoft Office XP Developer 打包向导来打包 Access 数据项目 (Access Data Project, ADP) 解决方案，该方案包括一个 Access Runtime/MSDE 数据库以便于分发。然而，您必须提供所需代码以便查找和启动 MSDE 服务器，以及将数据库附加到该服务器。本文将提供此类代码的示例。



简介

Microsoft® Desktop Engine (MSDE) 是 Microsoft Office XP Developer 附带的与 SQL Server 2000 兼容的数据存储服务器，允许再次分发。Office XP Developer 打包向导具有一个选项，可在打包 Access 数据项目 (ADP) 解决方案时包括 MSDE。在用户的计算机上安装解决方案后，MSDE 会随之安装。但是，MSDE 并不启动，数据库也不会附加到 MSDE。



本文提供了查找服务器、启动服务器（如果该服务器尚未启动）以及将数据库附加到服务器所需的代码。该代码特定用于 ADP；然而，大部分代码可用于任意 Visual Basic®for Applications (VBA) 应用程序。



一个前提条件是您必须具有 ADP 解决方案，并且其数据存储在 SQL Server 或 MSDE 数据库中。本文结尾部分提供该解决方案（不带数据库）的代码。还需注意，必须设置对 Microsoft SQL DMO 对象库和 Microsoft Scripting Runtime 的引用。

(另外，可参见 http://access911.net/fixhtm/72FAB11E10DCEAF3.htm)

zhuyiwen

启动 MSDE



此解决方案启动时，ADP 设置处于无连接状态。初次启动解决方案后，它将执行检查以查看是否已进行连接，如果没有，则将执行连接任务。由于同一台计算机上可有多个 MSDE 实例，而且实例的完整名称基于计算机名称与实例的名称组合，所以用于查找和启动 MSDE 的代码就很长。此示例代码将返回计算机上所有可用的 SQL/MSDE 实例，但存在限制：它仅使用找到的第一个实例。本文并不准备介绍该代码的详细使用情况，但是在本文结尾处的模块 modGetSQLInstances 部分，将提供有关说明。



如果知道要附加到的服务器的名称，可使用以下函数检查服务器的状态，并在必要时启动该服务器（请参见模块 modFirstRunADP）：

1. Public Function sStartMSDE(sSvrName As String, sUID As String, sPWD As String) As String
   
   
2. '********************************************************************
   
   
3. '该子例程将打开 MSDE。如果服务器已启动，
   
   
4. '错误捕获将退出该函数，服务器照常运行
   
   
5. '
   
   
6. '请注意，它不会将 SQL Service Manager 放到启动栏上。
   
   
7. '
   
   
8. '输入：
   
   
9. '   sSvrName    要启动的服务器
   
   
10. '   sUID        启动服务器的用户
    
    
11. '   sPWD        该用户的口令
    
    
12. '
    
    
13. '输出：
    
    
14. '   启动解决方案
    
    
15. '
    
    
16. '引用：
    
    
17. '   SQLDMO
    
    
18. '********************************************************************
    
    
19. 
    
    
20.     Dim osvr As SQLDMO.SQLServer
    
    
21. 
    
    
22.     Set osvr = CreateObject("SQLDMO.SQLServer")
    
    
23.     '创建 SQLDMO 服务器对象
    
    
24.         
    
    
25.     On Error GoTo StartError '错误捕获
    
    
26.    
    
    
27.     osvr.LoginTimeout = 60
    
    
28.     '启动服务器
    
    
29.     osvr.start True, sSvrName, sUID, sPWD
    
    
30.    
    
    
31.     '返回结果
    
    
32.     sStartMSDE = "已启动 " & sSvrName
    
    
33. 
    
    
34. ExitSub:
    
    
35.     Exit Function
    
    
36. 
    
    
37. StartError:
    
    
38.     If Err.Number = -2147023840 Then
    
    
39.     '如果服务器已在运行，
    
    
40.     '并且已在 NT 上执行 Server.Start，将产生此错误
    
    
41.         osvr.Connect sSvrName, sUID, sPWD '连接到服务器
    
    
42.         
    
    
43.         '返回结果
    
    
44.         sStartMSDE = sSvrName & " 已启动"
    
    
45.         
    
    
46.     Else '未知错误
    
    
47.         '返回结果
    
    
48.         sStartMSDE = Err.Description
    
    
49.     End If
    
    
50.    
    
    
51.     Resume ExitSub
    
    
52.    
    
    
53. End Function

复制代码

zhuyiwen

附加数据库



此函数执行将 MDF 数据文件附加到所选的服务器的任务。在此例中，我们使用了某些常量，您必须对它们进行相应更改，特别是数据库名“DemoDatabase”和 MDF 数据文件“adp1sql.mdf”。此外，该例还假设您使用 SQL 验证来附加到 MSDE 服务器（请参见模块 modFirstRunADP）：

1. Public Function sCopyMDF(sSvrName As String, _
   
   
2.        sUID As String, _
   
   
3.        sPWD As String, _
   
   
4.        sMDFName As String) As String
   
   
5. 
   
   
6. '********************************************************************
   
   
7. '此函数将检查 DemoDatabase 是否存在于
   
   
8. 'MSDE 服务器。如果数据库存在，此函数将
   
   
9. '从 ADP 所在的位置把 adp1
   
   
10. sql.mdf 复制到 MSDE Data
    
    
11. '目录。接着，附加 adp1sql.mdf。
    
    
12. '
    
    
13. '输入：
    
    
14. '   sSvrName    要启动的服务器
    
    
15. '   sUID        启动服务器的用户
    
    
16. '   sPWD        该用户的口令
    
    
17. '   sMDFName    要复制的 MSDE 数据库名称
    
    
18. '
    
    
19. '输出：
    
    
20. '   复制解决方案
    
    
21. '
    
    
22. '引用：
    
    
23. '   SQLDMO
    
    
24. '   Scripting Runtime
    
    
25. '********************************************************************
    
    
26. Dim FSO As Scripting.FileSystemObject
    
    
27. Dim osvr As SQLDMO.SQLServer
    
    
28. Dim strMessage As String
    
    
29. Dim db As Variant
    
    
30. Dim fDataBaseFlag As Boolean
    
    
31. Dim x
    
    
32. 
    
    
33. On Error GoTo sCopyMDFTrap
    
    
34. 
    
    
35.     'FSO.Copyfile 和 oSvr.AttachDBWithSingleFile
    
    
36.     '中使用的驱动器名称需要与最终用户计算机上的
    
    
37.     'Program Files 和 MSDE 的位置相匹配。
    
    
38. 
    
    
39.     '初始化返回值
    
    
40.     sCopyMDF = ""
    
    
41.     fDataBaseFlag = False
    
    
42.    
    
    
43.     Set FSO = CreateObject("Scripting.FileSystemObject")
    
    
44.     Set osvr = CreateObject("SQLDMO.SQLServer")
    
    
45.    
    
    
46.     '登录到数据库
    
    
47.     osvr.Connect sSvrName, sUID, sPWD
    
    
48.    
    
    
49.     x = osvr.Databases.Count  '如果失败，DMO 需要进行初始化
    
    
50.    
    
    
51.     '通过在本地 MSDE 服务器上依次检查所有数据库名称，
    
    
52.     '检查 DemoDatabase 是否存在于该服务器。
    
    
53.     For Each db In osvr.Databases
    
    
54.    
    
    
55.         If db.Name = "DemoDatabase" Then '该数据库存在
    
    
56.             fDataBaseFlag = True
    
    
57.             Exit For '退出循环
    
    
58.         End If
    
    
59.   
    
    
60.     Next
    
    
61.    
    
    
62.     If Not fDataBaseFlag Then '不存在名为 DemoDatabase 的数据库
    
    
63.         '将文件复制到数据文件夹
    
    
64.          FSO.CopyFile Application.CurrentProject.Path & "" & sMDFName, _
    
    
65.              osvr.Databases("主数据库").PrimaryFilePath & sMDFName, True
    
    
66.         '附加到数据库
    
    
67.         strMessage = osvr.AttachDBWithSingleFile("DemoDatabase", _
    
    
68.             osvr.Databases("主数据库").PrimaryFilePath & sMDFName)
    
    
69.         '返回结果
    
    
70.         sCopyMDF = "已复制 " & sMDFName & " 到 MSDE Data 目录"
    
    
71.     Else
    
    
72.         sCopyMDF = sMDFName & " 存在于 MSDE 服务器"
    
    
73.     End If
    
    
74.      
    
    
75. ExitCopyMDF:
    
    
76.     osvr.Disconnect
    
    
77.     Set osvr = Nothing
    
    
78. Exit Function
    
    
79.    
    
    
80. sCopyMDFTrap:
    
    
81. 
    
    
82.     If Err.Number = -2147216399 Then  'DMO 需进行初始化
    
    
83.         Resume Next
    
    
84.     Else
    
    
85.         sCopyMDF = Err.Description
    
    
86.     End If
    
    
87.     Resume ExitCopyMDF
    
    
88. Exit Function
    
    
89.    
    
    
90. End Function

复制代码

zhuyiwen

创建连接



将数据库附加到服务器后，最后一步就是创建 ADP 文件与数据库之间的连接。以下函数将执行此步骤（请参见模块 modFirstRunADP）：

1. Public Function sCopyMDF(sSvrName As String, _
   
   
2.         sUID As String, _
   
   
3.         sPWD As String, _
   
   
4.         sMDFName As String) As
   
   
5. String
   
   
6. 
   
   
7. '******************************************
   
   
8. '此函数将检查 ADP 中是否存在连接。如果连接
   
   
9. '不存在，它将使用输入参数创建一个连接
   
   
10. '
    
    
11. '输入：
    
    
12. '   sSvrName    要启动的服务器
    
    
13. '   sUID        启动服务器的用户
    
    
14. '   sPWD        该用户的口令
    
    
15. '   sDatabase   MSDE 数据库的名称
    
    
16. '
    
    
17. '输出：
    
    
18. '   复制解决方案
    
    
19. '
    
    
20. '******************************************
    
    
21. 
    
    
22.     On Error GoTo sCreateConnectionTrap:
    
    
23.    
    
    
24.     If Application.CurrentProject.BaseConnectionString = "" Then
    
    
25.         '此 ADP 无连
    
    
26.         sConnectionString = "PROVIDER=SQLOLEDB.1;PASSWORD=" & sPWD _
    
    
27.             & ";PERSIST SECURITY INFO=TRUE;USER ID=" & sUID & "; _
    
    
28.             INITIAL CATALOG=" & sDatabase & ";DATA SOURCE=" & sSvrName
    
    
29.         Application.CurrentProject.OpenConnection sConnectionString
    
    
30.         sCreateConnection = "已创建到此数据库的连接 " & sDatabase
    
    
31.     Else '存在连接
    
    
32.         sCreateConnection = "连接存在于 " & sDatabase
    
    
33.     End If
    
    
34.    
    
    
35.    
    
    
36. sCreateConnectionExit:
    
    
37. Exit Function
    
    
38. 
    
    
39. sCreateConnectionTrap:
    
    
40.     sCreateConnection = Err.Description
    
    
41.     Resume sCreateConnectionExit
    
    
42. 
    
    
43. End Function

复制代码

本文还包括用于从服务器删除数据库以及从 ADP 去除连接信息的代码。可将其用于测试目的（请参见模块 modCleanup）。

zhuyiwen

进行整合



要创建可分发的 Access Runtime/MSDE 数据库解决方案，必需具有此代码、数据库以及 Office XP Developer 打包向导。以下步骤将介绍如何进行整合：

• 针对现有的 SQL Server 或 MSDE 创建 Access ADP 解决方案。
  
• 在启动窗体中放置启动窗体代码。可能需要修改此代码以便符合启动窗体的要求。如果不想重置代码，就应删除 btnReset 函数。将该窗体设置为在启动时装载（菜单“工具”|“启动”）。
  
• 添加其余代码作为项目中的模块，并进行修改。
  
• 将 References 设置为 Microsoft SQL DMO 对象库和 Microsoft Scripting Runtime。
  
• 保存该项目，然后运行 Office XP Developer 打包向导。如果从“开始”菜单运行打包向导，请选择 ADP 文件作为主文件。
  
• 在打包向导中，确保已设置以下选项：
  
  
  
  
  • 已选择 Access Runtime。
    
  • 已选择 MSDE。
    
  • 还可以选择从快捷菜单属性中，为帮助文件、标题、图标和启动位图设置 Access Runtime 配置文件。
    
    

完成打包向导，并构建安装程序。



至此，该解决方案应准备就绪，可以安装到任一台计算机。



问题

最难解决的问题是确定用户计算机上特定 MSDE 实例的任务。如果随解决方案安装的 MSDE 实例是计算机上唯一的实例，则此解决方案最为有效。如果有多个实例，并且您需要将数据库连接到特定实例，就必须提供额外代码，以便向用户请求实例名。遗憾的是，打包向导并不保存它所安装的实例名称。

zhuyiwen

启动窗体代码



提供此代码的目的是出于完整性的考虑，并演示如何将其它所有部分整合到一起。要使用此代码，请创建窗体，然后在其上放置一个按钮（名为 btnReset）。将此代码附于窗体后面，然后把此窗体设置为启动时装载

1. Option Compare Database
   
   
2. Option Explicit
   
   
3. Dim SQLInstance As String
   
   
4. '此窗体具有一个按钮，可重置解决方案 – btnReset。  这将
   
   
5. '使 ADP 处于无连接状态，并从服务器删除数据库，
   
   
6. '从而易于对代码进行重新测试。
   
   
7. '然而，不应将其作为已部署的解决方案的一部分。
   
   
8. 
   
   
9. Private Sub btnReset_Click()
   
   
10. '可以重置解决方案，方法是使 ADP 处于非连接状态，然后从
    
    
11. '服务器删除数据库。
    
    
12.     DeleteMDF SQLInstance, "sa", "", "DemoDatabase"
    
    
13.     '删除当前数据库
    
    
14.     MakeADPConnectionless '使 ADP 处于无连接状态
    
    
15. End Sub
    
    
16. 
    
    
17. Private Sub Form_Open(Cancel As Integer)
    
    
18.     Dim sSQLInt As String
    
    
19.     Dim b As Boolean
    
    
20.     Dim x As Integer
    
    
21. 
    
    
22.     '在该计算机上查找可用的 MSDE/SQL 实例
    
    
23.     x = GetValidSQLInstances(sSQLInt, b)
    
    
24.     SQLInstance = ComputerName & "" & sSQLInt
    
    
25. 
    
    
26.     '从 modFistRunADP 调用 startMSDE，并将结果返回到消息框
    
    
27.     MsgBox sStartMSDE(SQLInstance, "sa", "")
    
    
28. 
    
    
29.     '从 modFistRunADP 调用 sCopyMDF，并将结果返回到消息框
    
    
30.     MsgBox sCopyMDF(SQLInstance, "sa", "", "starssql.mdf")
    
    
31. 
    
    
32.     '从 modFistRunADP 调用 sCreateConnection，并将结果返回到消息框
    
    
33.     MsgBox sCreateConnection(SQLInstance, "sa", "", "DemoDatabase")
    
    
34. End Sub

复制代码

zhuyiwen

模块 modGetSQLInstances

1. Option Compare Database
   
   
2. '此模块提供的函数共同执行
   
   
3. '查找现有的 SQL Server 和计算机名称的任务。
   
   
4. Private Declare Function OSRegOpenKey Lib "advapi32" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpszSubKey As String, phkResult As Long) As Long
   
   
5. Private Declare Function OSRegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpszValueName As String, ByVal dwReserved As Long, lpdwType As Long, lpbData As Any, cbData As Long) As Long
   
   
6. Private Declare Function OSRegCloseKey Lib "advapi32" Alias "RegCloseKey" (ByVal hKey As Long) As Long
   
   
7. Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" ( _
   
   
8.     ByVal lpBuffer As String, nSize As Long) As Long
   
   
9. 
   
   
10. Public Const HKEY_CLASSES_ROOT = &H80000000
    
    
11. Public Const HKEY_CURRENT_USER = &H80000001
    
    
12. Public Const HKEY_LOCAL_MACHINE = &H80000002
    
    
13. Public Const HKEY_USERS = &H80000003
    
    
14. Private Const ERROR_SUCCESS = 0&
    
    
15. 
    
    
16. Private Const REG_SZ = 1
    
    
17. Private Const REG_BINARY = 3
    
    
18. Private Const REG_DWORD = 4
    
    
19. Private Const REG_MULTI_SZ = 7
    
    
20. 
    
    
21. '-----------------------------------------------------------
    
    
22. ' SUB: GetValidSQLInstances
    
    
23. '
    
    
24. ' 返回有效的 SQL 实例个数和表示实例列表的字符串
    
    
25. ' （以空格分隔）。
    
    
26. '-----------------------------------------------------------
    
    
27. '
    
    
28. Public Function GetValidSQLInstances(ByRef sSQLInstances As String, ByRef fIsDefaultSQL7 As Boolean) As Integer
    
    
29.     Dim hKey As Long
    
    
30.     Dim sValue As String
    
    
31.     'Dim sVerInfo As VERINFO
    
    
32.     Dim i As Integer
    
    
33. 
    
    
34.     fIsDefaultSQL7 = False
    
    
35.     sSQLInstances = ""
    
    
36.     GetValidSQLInstances = 0
    
    
37.     If RegOpenKey(HKEY_LOCAL_MACHINE, "Software\Microsoft\Microsoft SQL Server", hKey) Then
    
    
38.         RegQueryStringValue hKey, "InstalledInstances", sSQLInstances
    
    
39.         RegCloseKey hKey
    
    
40.         StrConv sSQLInstances, vbUpperCase
    
    
41.         If InStr(1, sSQLInstances, "MSSQLSERVER") Then
    
    
42.            If RegOpenKey(HKEY_LOCAL_MACHINE, "Software\Microsoft\MSSQLServer\MSSQLServer\CurrentVersion", hKey) Then
    
    
43.                 RegQueryStringValue hKey, "CurrentVersion", sValue
    
    
44.                 RegCloseKey hKey
    
    
45.                 'PackVerInfo sValue, sVerInfo
    
    
46.                 'If sVerInfo.FileVerPart1 = 7 Then
    
    
47.                 'fIsDefaultSQL7 = True
    
    
48.                 'End If
    
    
49.             End If
    
    
50.         End If
    
    
51.         For i = 1 To Len(sSQLInstances)
    
    
52.             If Mid$(sSQLInstances, i, 1) = " " Then
    
    
53.                 GetValidSQLInstances = GetValidSQLInstances + 1
    
    
54.             End If
    
    
55.         Next i
    
    
56.     End If
    
    
57. End Function
    
    
58. 
    
    
59. 
    
    
60. '-----------------------------------------------------------
    
    
61. ' 函数：RegOpenKey
    
    
62. '
    
    
63. ' 打开系统注册表中现有的键。
    
    
64. '
    
    
65. ' 返回：如果成功打开该键，则为 True，否则为 False
    
    
66. '   如果成功打开，将把 phkResult 设置为该键的句柄。
    
    
67. '-----------------------------------------------------------
    
    
68. '
    
    
69. Public Function RegOpenKey(ByVal hKey As Long, ByVal lpszSubKey As String, phkResult As Long) As Boolean
    
    
70.     Dim lResult As Long
    
    
71.     Dim strHkey As String
    
    
72. 
    
    
73.     strHkey = strGetHKEYString(hKey)
    
    
74. 
    
    
75.     lResult = OSRegOpenKey(hKey, lpszSubKey, phkResult)
    
    
76.     If lResult = ERROR_SUCCESS Then
    
    
77.         RegOpenKey = True
    
    
78.     End If
    
    
79. End Function
    
    
80. 
    
    
81. '-----------------------------------------------------------
    
    
82. ' 函数：RegCloseKey
    
    
83. '
    
    
84. ' 关闭打开的注册表键。
    
    
85. '
    
    
86. ' 返回：成功完成为 True，否则为 False。
    
    
87. '-----------------------------------------------------------
    
    
88. '
    
    
89. Public Function RegCloseKey(ByVal hKey As Long) As Boolean
    
    
90.     Dim lResult As Long
    
    
91. 
    
    
92.     lResult = OSRegCloseKey(hKey)
    
    
93.     RegCloseKey = (lResult = ERROR_SUCCESS)
    
    
94. End Function
    
    
95. 
    
    
96. '-----------------------------------------------------------
    
    
97. '如果是 HKEY，将返回表示该键的
    
    
98. '文本字符串。
    
    
99. '-----------------------------------------------------------
    
    
100. 
     
     
101. Private Function strGetHKEYString(ByVal hKey As Long) As String
     
     
102.     Dim s

复制代码

zhuyiwen

模块 modFirstRunADP

<DIV>

<FONT face=Verdana size=2>Option Compare Database



'此项目中的代码将演示如何把 MDF 文件

'连接到本地 MSDE，然后建立与无连接状态的 ADP

'的连接。





Public Function sStartMSDE(sSvrName As String, sUID As String, sPWD As String) As String

'********************************************************************

'该子例程将打开 MSDE。如果服务器已启动，

'错误捕获将退出该函数，服务器照常运行

'

'请注意，它不会将 SQL Service Manager 放到启动栏上。

'

'输入：

'   sSvrName    要启动的服务器

'   sUID        启动服务器的用户

'   sPWD        该用户的口令

'

'输出：

'   启动解决方案

'

'引用：

'   SQLDMO

'********************************************************************



    Dim osvr As SQLDMO.SQLServer



    Set osvr = CreateObject("SQLDMO.SQLServer")

    '创建 SQLDMO 服务器对象

        

    On Error GoTo StartError '错误捕获

   

    osvr.LoginTimeout = 60

    '启动服务器

    osvr.start True, sSvrName, sUID, sPWD

   

    '返回结果

    sStartMSDE = "已启动 " & sSvrName



ExitSub:

    Exit Function



StartError:

    If Err.Number = -2147023840 Then

    '如果服务器已在运行，

    '并且已在 NT 上执行了 Server.Start，将产生此错误

        osvr.Connect sSvrName, sUID, sPWD '连接到服务器

        

        '返回结果

        sStartMSDE = sSvrName & " 已启动"

        

    Else '未知错误

        '返回结果

        sStartMSDE = Err.Description

    End If

   

    Resume ExitSub

   

End Function





Public Function sCopyMDF(sSvrName As String, sUID As String, sPWD As String, sMDFName As String)

As String



'********************************************************************

'此函数将检查 MSDE 服务器上是否存在 DemoDatabase。如果数据库存在，此函数将

'从 ADP 所在的位置把 adp1

sql.mdf 复制到 MSDE Data

'目录。接着，附加 adp1sql.mdf。

'

'输入：

'   sSvrName    要启动的服务器

'   sUID        启动服务器的用户

'   sPWD        该用户的口令

'   sMDFName    要复制的 MSDE 数据库的名称

'

'输出：

'   复制解决方案

'

'引用：

'   SQLDMO

'   Scripting Runtime

'********************************************************************

Dim FSO As Scripting.FileSystemObject

Dim osvr As SQLDMO.SQLServer

Dim strMessage As String

Dim db As Variant

Dim fDataBaseFlag As Boolean

Dim x



On Error GoTo sCopyMDFTrap



    'FSO.Copyfile 和 oSvr.AttachDBWithSingleFile

    '中使用的驱动器名称需要与最终用户计算机上的

    'Program Files 和 MSDE 的位置相匹配。



    '初始化返回值

    sCopyMDF = ""

    fDataBaseFlag = False

   

    Set FSO = CreateObject("Scripting.FileSystemObject")

    Set osvr = CreateObject("SQLDMO.SQLServer")

   

    '登录到数据库

    osvr.Connect sSvrName, sUID, sPWD

   

    x = osvr.Databases.Count  '如果失败，DMO 需要进行初始化

   

    '通过在本地 MSDE 服务器上循环检查所有数据库名称，

    '检查 DemoDatabase 是否存在于该服务器。

    For Each db In osvr.Databases

   

        If db.Name = "DemoDatabase" Then '该数据库存在

            fDataBaseFlag = True

            Exit For '退出循环

        End If

  

    Next

   

    If Not fDataBaseFlag Then '不存在名为 DemoDatabase 的数据库

        '将文件复制到数据文件夹

         FSO.CopyFile Application.CurrentProject.Path & "\" & sMDFName, _

             osvr.Databases("主数据库").PrimaryFilePath & sMDFName, True

        '附加到数据库

        strMessage = osvr.AttachDBWithSingleFile("DemoDatabase", _

            osvr.Databases("主数据库").PrimaryFilePath & sMDFName)

        '返回结果

        sCopyMDF = "已复制 " & sMDFName &amp

zhuyiwen

模块 modCleanup



Option Compare Database



'按照设计，此代码用于重置该示例。然而，它将使用 MakeADPConnectionless 创建

'无连接的 ADP。



Sub MakeADPConnectionless()

'********************************************************************

'此子例程将从 ADP 删除连接,使其

'处于无连接状态。

'********************************************************************

    Application.CurrentProject.CloseConnection '关闭连接

    Application.CurrentProject.OpenConnection '将连接设置为无

End Sub



Sub DeleteMDF(sSvrName As String, sUID As String, sPWD As String, sDatabase As String)

'********************************************************************

'此子例程将使用 SQLDMO

'从 MSDE 服务器删除当前连接的数据库

'

'注：有一种循环带有错误捕获，可避免删除一个

'连接

'

'引用：

'   adodb

'********************************************************************

    Dim osvr As SQLDMO.SQLServer

    Dim i As Integer



    On Error GoTo DeleteMDFTrap

   

    Application.CurrentProject.CloseConnection

'关闭连接



    Set osvr = CreateObject("SQLDMO.SQLServer") '创建 SQLDMO 对象

    osvr.Connect sSvrName, sUID, sPWD '连接到 MSDE 服务器

   

    osvr.Databases(sDatabase).Remove '删除数据库

   

   

DeleteMDFExit: '清除

    osvr.Close

    Set osvr = Nothing

Exit Sub



   

DeleteMDFTrap:

    Select Case Err.Number

   

    Case 6008 '避免关闭连接的问题

        If i < 99 Then '继续循环以尝试关闭连接

            DoEvents

            Resume

        Else '连接由于某种原因而无法关闭

             '因此停止尝试并退出

            MsgBox Err.Description

            Resume DeleteMDFExit

        End If

            

    Case Else

        MsgBox Err.Description

        Resume DeleteMDFExit

    End Select

Exit Sub



End Sub

zhuyiwen

<-- 全文完 -->