ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   A macro to authorize a user to run another macro. (https://www.excelbanter.com/excel-programming/442512-macro-authorize-user-run-another-macro.html)

abhay-547

A macro to authorize a user to run another macro.
 
Hi All,

I have created an excel addin which contains some macros but i have sent the
same to all my team members but i want to restrict some of the team members from
using the same .i.e who are not authorized to use the above mentioned addin. So
I want a macro which should first check the existence of a user's XP ID in my
sql database table and then allow him to run the macro from my addin. If the
user's XP ID is not present in my sql database then it should show a message
that "You are not a authorized user to run this macro". I have a code with me
which actually checks the existence of Windows XP user id in Excel workbook but
I want a code which should check the existence of XP id in sql server table.
Following is the code :

I have the below code so far :

Sub Test() Dim ws As Worksheet Dim strSQL As String Dim strConnection_String As
String Dim x As String Dim strFilePathOfAuthorizedUsersFile As String
'----------------------------------------------------------- 'NOTE: Requires
reference to ADO library: ' 1. Open the Visual Basic Editor (Alt + Fll) ' 2.
Choose Tools | References ' 3. Check box for Microsoft ActiveX Data Object 2.8
Library (or higher) '-----------------------------------------------------------
'----------------------------------------------------------- 'ENTER YOUR SOURCE
FILE WHERE NAMES ARE KEPT '1) Must be an Excel file with One Column, '2) Column
header must be labeled: "NameOfAuthorizedUser" '3) Data is a named range call
"MyRange" strFilePathOfAuthorizedUsersFile = "C:\MySourceTest.xls"
'----------------------------------------------------------- 'SQL String strSQL
= _ "SELECT NameOfAuthorizedUser " _ & "FROM myRange " _ & "WHERE " _ &
"NameOfAuthorizedUser = '" & Environ("Username") & "';" 'Connection String to
get data from an Excel file strConnection_String = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" &
strFilePathOfAuthorizedUsersFile & ";" & _ "Extended Properties=Excel 8.0;" x =
CheckForAuthorizedUser(strConnection_String, strSQL) If x < "" Then MsgBox
"User " & x & " Found!" Else MsgBox "No Authorized User Found." End If End Sub
Function CheckForAuthorizedUser(ByVal strConnection_String As String, ByVal
strSQL As String) As String 'Creates a recordset from Excel, using filter
criteria from the calling sub 'Returns a name or an empty string
'----------------------------------------------------------- 'NOTE: Requires
reference to ADO library: ' 1. Open the Visual Basic Editor (Alt + Fll) ' 2.
Choose Tools | References ' 3. Check box for Microsoft ActiveX Data Object 2.8
Library (or higher) '-----------------------------------------------------------
Dim x As Long Dim myRecordset As ADODB.Recordset Set myRecordset = New
ADODB.Recordset 'sql string - uses module-level constants Debug.Print strSQL
'initialize recordset and run the query Call myRecordset.Open(strSQL,
strConnection_String, CursorTypeEnum.adOpenForwardOnly, _
LockTypeEnum.adLockReadOnly, CommandTypeEnum.adCmdText) 'Results If Not
myRecordset.EOF Then CheckForAuthorizedUser = myRecordset.fields(0).Value Else
CheckForAuthorizedUser = "" End If 'Close recordset object and release memory If
(myRecordset.State And ObjectStateEnum.adStateOpen) Then myRecordset.Close Set
myRecordset = Nothing End Function


Please expedite... I already have the above mentioned code in place which works
fine with excel I just want to use the same with SQL data table and apart from
that I require some thing like below.

Example code required by me :

Sub MyMacro() If Application.Run "Test" = True Then ' I know that this is not a
valid statement in VBA but I am just trying to explain the logic with this
example. 'then my other macro code otherwise if it is false then Exit sub with a
message "That you are not authorized to run this macro" Application.Run
"othermacro" End if End Sub

Thanks for your help in advance.


All times are GMT +1. The time now is 03:38 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com