'' 设置打开 ADP 程序的参数
　　srvname = "(local)"
　　dbname = "NorthwindCS"　'' ADP 连接的数据库
　　prpath = "C:\Documents and Settings\Administrator\My Documents\"　　'' ADP 文件所在的磁盘位置
　　prname = "NorthwindCS"　'' ADP 文件名
　　suid = "msdn5"
　　pwd = "password"
　　
　　'' 该参数用于控制当前用户使用 Windows 登录
　　'' 代替 SQL Server 的 suid 和 pwd
　　bolWindowsLogin = False
　　
　　'' 使用 Windows 或 SQL Server 登录调用打开名为 prname ADP 的子程序
　　OpenADPWindowsOrSQLServer srvname, dbname, prpath, prname, suid, pwd, bolWindowsLogin
End Sub

Sub OpenADPWindowsOrSQLServer(srvname As String, dbname As String, _
　　prpath As String, prname As String, _
　　suid As String, pwd As String, bolWindowsLogin As Boolean)

　　Dim bolLeaveOpen As Boolean
　　Dim strPrFilePath As String
　　Dim sConnectionString As String
　　
　　'' 是否保持现有打开的程序?
　　If MsgBox("在该过程中是否关闭打开的 ADP?", vbYesNo) = vbYes Then
　　　　bolLeaveOpen = True
　　End If
　　
　　'' 新建 Access 会话实例 (使用 .9 : Access 2000, .10 : Access 2002)
　　Set appAccess = CreateObject("Access.Application.9")
　　
　　'' 使用登录名和口令打开 ADP 并使其可视
　　strPrFilePath = prpath & prname
　　appAccess.OpenAccessProject strPrFilePath
　　appAccess.Visible = True
　　
　　'' 指定 ADP 使用的新的 Windwos 或 SQL Server 登录方式
　　If bolWindowsLogin Then
　　　　appAccess.CurrentProject.OpenConnection _
　　　　　　"PROVIDER=SQLOLEDB.1;INTEGRATED SECURITY=SSPI;" & _
　　　　　　"PERSIST SECURITY INFO=FALSE;INITIAL CATALOG=" & _
　　　　　　dbname & ";DATA SOURCE=" & srvname
　　Else
　　　　sConnectionString = "PROVIDER=SQLOLEDB.1;INITIAL CATALOG=" & _
　　　　　　dbname & ";DATA SOURCE=" & srvname
　　　　appAccess.CurrentProject.OpenConnection _
　　　　　　sConnectionString, _
　　　　　　suid, pwd
　　End If
　　
　　'' 按上面提出的要求关闭 Access 会话实例
　　If bolLeaveOpen = False Then
　　　　appAccess.CloseCurrentDatabase
　　　　Set appAccess = Nothing
　　End If
End Sub

Sub CallLoginDemo()
　　Dim srvname As String
　　Dim suid As String
　　Dim pwd As String
　　
　　'' 设置登录 SQL Server 的参数
　　srvname = "(local)"
　　suid = "sa"
　　pwd = ""
　　
　　'' 调用 SQL Server 登录子程序
　　LoginDemo srvname, suid, pwd
End Sub


Sub LoginDemo(srvname As String, suid As String, pwd As String)
　　Dim srv1 As SQLDMO.SQLServer
　　Dim lgn1 As SQLDMO.Login
　　
　　'' 新建一服务器实例
　　Set srv1 = New SQLDMO.SQLServer
　　
　　'' 以 SQL Server 方式连接 SQL Server
　　srv1.Connect srvname, suid, pwd
　　
　　'' 新建登录对象
　　Set lgn1 = New SQLDMO.Login
　　
　　'' 添加默认 SQL Server 登录 msdn6
　　lgn1.Name = "UserX"
　　lgn1.Database = "NorthwindCS"
　　lgn1.SetPassword "", "password"
　　srv1.Logins.Add lgn1
　　
　　''重新新建登录对象
　　Set lgn1 = New SQLDMO.Login
　　
　　'' 添加基于 Windows 组 SQL_users 的登录对象
　　lgn1.Name = "MYDESK\UserSQL"
　　lgn1.Database = "NorthwindCS"
　　lgn1.Type = SQLDMOLogin_NTGroup
　　srv1.Logins.Add lgn1
　　
　　'' 在添加登录后，列出登录列表
　　Debug.Print "添加 2 个新登录后的登录列表:"
　　For Each lgn1 In srv1.Logins
　　　　Debug.Print DecodeLoginType(lgn1.Type), lgn1.Name
　　Next lgn1
　　
　　'' 删除刚新建的登录
　　srv1.Logins.Remove "MYDESK\UserSQL"
　　srv1.Logins.Remove "UserX"
　　
　　'' 列出登录列表
　　Debug.Print vbCr & "删除 2 个新登录后的登录列表:"
　　For Each lgn1 In srv1.Logins
　　　　Debug.Print DecodeLoginType(lgn1.Type), lgn1.Name
　　Next lgn1
　　
　　'' 断开连接
　　srv1.Disconnect
　　Set srv1 = Nothing
End Sub


Function DecodeLoginType(lgn_type As Byte) As String

　　Select Case lgn_type
　　　　Case 0
　　　　　　DecodeLoginType = "SQLDMOLogin_NTUser"
　　　　Case 1
　　　　　　DecodeLoginType = "SQLDMOLogin_NTGroup"
　　　　Case 2
　　　　　　DecodeLoginType = "SQLDMOLogin_Standard"
　　　　Case Else
　　　　　　DecodeLoginType = "超出范围"
　　End Select

End Function

Sub MakeLoginWithDatareaderUser()
　　Dim srv1 As SQLDMO.SQLServer
　　Dim lgn1 As SQLDMO.Login
　　Dim usr1 As SQLDMO.User
　　Dim srvname As String
　　Dim suid As String
　　Dim pwd As String
　　Dim dbname As String
　　Dim prpath As String
　　Dim prname As String
　　Dim bolWindowsLogin As Boolean
　　
　　'' 设置参数
　　srvname = "(local)"
　　suid = "sa"
　　pwd = ""
　　dbname = "NorthwindCS"
　　
　　'' 新建服务器实例
　　Set srv1 = New SQLDMO.SQLServer
　　
　　'' 以 SQL Server 登录方式进行连接
　　srv1.Connect srvname, suid, pwd
　　
　　'' 新建一个 SQL Server 登录对象 UserX
　　suid = "UserX"
　　Set lgn1 = New SQLDMO.Login
　　lgn1.Name = suid
　　lgn1.Database = dbname
　　lgn1.SetPassword "", pwd
　　srv1.Logins.Add lgn1
　　
　　'' 在数据库 NorthwindCS 上新建一个用户对象 UserX，并与登录对象 UserX 相关联
　　Set usr1 = New SQLDMO.User
　　usr1.Name = suid
　　usr1.Login = lgn1.Name
　　srv1.Databases(dbname).Users.Add usr1
　　srv1.Databases(dbname).DatabaseRoles("db_datareader").AddMember usr1.Name
　　
　　'' 设置调用 ADP 的子程序参数
　　prpath = "C:\Documents and Settings\Administrator\My Documents\"
　　prname = "NorthwindCS"
　　
　　'' 该参数用于控制当前用户使用 Windows 登录
　　'' 代替 SQL Server 的 suid 和 pwd
　　bolWindowsLogin = False
　　
　　'' 使用 Windows 或 SQL Server 登录调用打开名为 prname ADP 的子程序
　　OpenADPWindowsOrSQLServer srvname, dbname, prpath, prname, suid, pwd, bolWindowsLogin
End Sub


Sub CleanUpAfterMakeLoginWithDAtaReader()
　　Dim srv1 As New SQLDMO.SQLServer
　　
　　srv1.Connect "(local)", "sa", ""
　　
　　srv1.Databases("NorthwindCS").Users.Remove "UserX"
　　srv1.Logins.Remove "UserX"
End Sub