Public Function sCopyMDF(sSvrName As String, sUID As String, sPWD As String, sMDFName As String) As String '******************************************************************** '这个函数将检查MSDE服务器上是否存在 DemoDatabase 数据库,如果不存在,则 '本函数将把ADP项目中所用的 adp1sql1.mdf 文件复制到MSDE的数据目录,并建立引用 ' '输入: ' 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 '中程序匹配的位置和终端用户机器上的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服务器轮询,检查本地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 的数据库 '复制文件到MSDE的数据目录 FSO.CopyFile Application.CurrentProject.Path & "\" & sMDFName, _ osvr.Databases("master").PrimaryFilePath & sMDFName, True '匹配数据库 strMessage = osvr.AttachDBWithSingleFile("DemoDatabase", _ osvr.Databases("master").PrimaryFilePath & sMDFName) '返回结果 sCopyMDF = "已复制 " & sMDFName & " 到 MSDE 数据文件目录" Else sCopyMDF = "在MSDE服务器上已经存在 " & sMDFName End If ExitCopyMDF: osvr.Disconnect Set osvr = Nothing Exit Function sCopyMDFTrap: If Err.Number = -2147216399 Then 'DMO 需要初始化 Resume Next Else sCopyMDF = Err.Description End If Resume ExitCopyMDF Exit Function End Function 1、用于ADP项目发布时,安装SQL Server数据库。 2、当SQL Server崩溃后,只要SQL Server的数据库.mdf文件未损坏,即可用本例程序恢复。 |
|站长邮箱|小黑屋|手机版|Office中国/Access中国
( 粤ICP备10043721号-1 )
GMT+8, 2025-4-2 13:00 , Processed in 0.164239 second(s), 24 queries .
Powered by Discuz! X3.3
© 2001-2017 Comsenz Inc.