Post reply

Add SQL User from Access using VBA

  • August 27, 2008 at 12:57 pm

    #70990

    How do I Add/Change/Delete SQL User details from within a VBA function?

    I am building a VBA driven SQL Administration subsystem and will need to perform many of the SQL Server DDL/DCL commands from within an ACCDB/ACCDE file through linked in tables.

  • August 28, 2008 at 7:48 am

    #864391

    Here's what I use to add users to specific databases... it should get you started.

    Function CreateNewSQLUser(NewUserName As String, SQLdbName As String)

    On Error GoTo PROC_ERR

    Dim bsSQL As String

    bsSQL = "USE [master] "

    bsSQL = bsSQL + "if not exists (select * from master.dbo.syslogins where loginname = N'" & NewUserName & "')"

    bsSQL = bsSQL + "BEGIN "

    bsSQL = bsSQL + " declare @logindb nvarchar(132), @loginlang nvarchar(132) select @logindb = N'master', @loginlang = N'us_english'"

    bsSQL = bsSQL + " if @logindb is null or not exists (select * from master.dbo.sysdatabases where name = @logindb)"

    bsSQL = bsSQL + " select @logindb = N'master'"

    bsSQL = bsSQL + " if @loginlang is null or (not exists (select * from master.dbo.syslanguages where name = @loginlang) and @loginlang <> N'us_english')"

    bsSQL = bsSQL + " select @loginlang = @@language"

    bsSQL = bsSQL + " exec sp_addlogin N'" & NewUserName & "', null, @logindb, @loginlang"

    bsSQL = bsSQL + " exec sp_grantlogin N'" & NewUserName & "'"

    bsSQL = bsSQL + " exec sp_defaultdb N'" & NewUserName & "', N'master'"

    bsSQL = bsSQL + " exec sp_defaultlanguage N'" & NewUserName & "', N'us_english'"

    bsSQL = bsSQL + "END "

    bsSQL = bsSQL + " USE [master] "

    bsSQL = bsSQL + "exec sp_grantdbaccess '" & NewUserName & "', '" & Right(NewUserName, Len(NewUserName) - InStr(1, NewUserName, "\")) & "'"

    bsSQL = bsSQL + " USE [msdb] "

    bsSQL = bsSQL + "exec sp_grantdbaccess '" & NewUserName & "', '" & Right(NewUserName, Len(NewUserName) - InStr(1, NewUserName, "\")) & "'"

    bsSQL = bsSQL + " USE [tempdb] "

    bsSQL = bsSQL + "exec sp_grantdbaccess '" & NewUserName & "', '" & Right(NewUserName, Len(NewUserName) - InStr(1, NewUserName, "\")) & "'"

    bsSQL = bsSQL + " USE [" & SQLdbName & "] "

    bsSQL = bsSQL + "exec sp_grantdbaccess '" & NewUserName & "', '" & Right(NewUserName, Len(NewUserName) - InStr(1, NewUserName, "\")) & "'"

    Dim qdef As DAO.QueryDef

    Set qdef = CurrentDb.QueryDefs("qryTempPassthrough")

    qdef.Connect = "ODBC;" & GetConnString()

    qdef.ODBCTimeout = 120

    qdef.sql = bsSQL

    qdef.Close

    Set qdef = Nothing

    DoCmd.OpenQuery ("qryTempPassthrough")

    PROC_EXIT:

    DoCmd.SetWarnings True

    Exit Function

    PROC_ERR:

    If Err.Number = 3325 Or Err.Number = 3146 Or Err.Number = 3270 Then Resume PROC_EXIT

    If Err.Number = 3390 Then

    MsgBox "This User Name already exists."

    DoCmd.Close acForm, "frmAddEdd_NewUser", acSaveNo

    Resume PROC_EXIT

    Else

    MsgBox Err.Number & ", " & Err.Description & " on basSecure in CreateNewUser ", , AppErrTitle

    End If

    Resume PROC_EXIT

    Resume

    End Function

Viewing 2 posts - 1 through 1 (of 1 total)

You must be logged in to reply to this topic. Login to reply