abhay_547
06-21-2010, 12:22 PM
Hi All,
I have a macro which checks the existence of a particular text .i.e. Windows XP ID of a user in a sql database table and only then allows him to go ahead and run a macro, basically I wanted this macro for a authorization check. Now I have one more query .i.e. as below as of now I have put the above mentioned XP ID checking code in my userforms initiate event. Now I want to incorporate on more authorization check in my command button event. Following is the code which I have in initiate event of userform which works fine:
Private Sub UserForm_Initialize()
Dim strSQL As String
Dim strConnection_String As String
Dim x As String
'SQL String
strSQL = _
"SELECT XPUserID " _
& "FROM AuthorizedUserList " _
& "WHERE " _
& "XPUserID = '" & Environ("Username") & "';"
'Connection String to get data from an SQL Table
Dim connStr As String
Dim myservername As String
Dim mydatabase As String
Dim myuserid As String
Dim mypasswd As String
myservername = ThisWorkbook.Sheets(1).Cells(1, 3).Value
mydatabase = ThisWorkbook.Sheets(1).Cells(1, 5).Value
myuserid = ThisWorkbook.Sheets(1).Cells(1, 1).Value
mypasswd = ThisWorkbook.Sheets(1).Cells(1, 2).Value
strConnection_String = _
"Provider=SQLOLEDB.1;DRIVER=SQL Native Client;Password=" & mypasswd & ";Persist Security Info=false;User ID=" & myuserid & ";Initial Catalog=" & mydatabase & ";Data Source=" & myservername & ";"
x = CheckForAuthorizedUser(strConnection_String, strSQL)
If x <> "" Then
extractdataform.show
else
Msgbox "You don't have access to extract data sql macro"
End sub
'Other Module :
Function CheckForAuthorizedUser(ByVal strConnection_String As String, ByVal strSQL As String) As String
'Creates a recordset from SQL, using filter criteria from the calling sub
'Returns a name or an empty string
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
Now I have following code in my command button event. I have a Combobox on my userform .i.e. Combobox6 now this combobox gets populated with product codes Now I don't want to give access of all products to all users so what I am trying to do is I have sql table in my sql database .i.e AuthorizedUserList which contains 3 columns .i.e one is XPUserID, Name of the User and third is Product now I want to incorporate a line of code in my below commandbutton event which will check the product to which user has the access and only then it will allow him to extract the data for the same otherwise it will show a message that he doesn't have access to the Product which he has selected in Combobox6. Now what my macro will do is that it will get the windows xp user id of the user and on the basis of that it will get the product which is updated against same xpuser id in my "AuthorizedUserlist" table and then accordingly it allow user to extract the data. I have tried to write something from my end in the below commandbutton event but it doesn't work, I have highlighted the same in Red.
Private Sub CommandButton5_Click()
Workbooks.Add
'Selection String for Sub Product UBR Code
Dim selection As String
Dim lItem As Long
For lItem = 0 To ListBox4.ListCount - 1
If ListBox4.Selected(lItem) = True Then
selection = selection & "'" & Replace(Left(ListBox4.List(lItem), 6), "'", "''") & "',"
End If
Next
selection = Mid(selection, 1, Len(selection) - 1)
'Selection String For Country
Dim selection1 As String
Dim lItem1 As Long
For lItem1 = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(lItem1) = True Then
selection1 = selection1 & "'" & Replace(ListBox1.List(lItem1), "'", "''") & "',"
End If
Next
selection1 = Mid(selection1, 1, Len(selection1) - 1)
Dim selection2 As String
Dim lItem2 As Long
For lItem2 = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(lItem2) = True Then
selection2 = selection2 & "'" & Replace(Left(ListBox2.List(lItem2), 11), "'", "''") & "',"
End If
Next
selection2 = Mid(selection2, 1, Len(selection2) - 1)
' Setup connection string
Dim connStr As String
Dim myservername As String
Dim mydatabase As String
Dim myuserid As String
Dim mypasswd As String
myservername = ThisWorkbook.Sheets(1).Cells(1, 3).Value
mydatabase = ThisWorkbook.Sheets(1).Cells(1, 5).Value
myuserid = ThisWorkbook.Sheets(1).Cells(1, 1).Value
mypasswd = ThisWorkbook.Sheets(1).Cells(1, 2).Value
connStr = "Provider=SQLOLEDB.1;DRIVER=SQL Native Client;Password=" & mypasswd & ";Persist Security Info=false;User ID=" & myuserid & ";Initial Catalog=" & mydatabase & ";Data Source=" & myservername & ";"
' Setup the connection to the database
Dim connection As ADODB.connection
Set connection = New ADODB.connection
connection.ConnectionString = connStr
' Open the connection
connection.Open
' Open recordset.
Set cmd1 = New ADODB.Command
cmd1.ActiveConnection = connection
If cmd1.CommandText = "SELECT DISTINCT Product FROM AuthorizedUserList INNER JOIN Data_SAP.dbo.AuthorizedUserList ON (AuthorizedUserList.XPUserID = '" & Environ("Username") & "') WHERE Product = '" & Left(ComboBox6.Value, 6) & "';"
MsgBox "You are not authorized to extract data for the selected UBR / Cost Center Group"
Else
cmd1.CommandText = "SELECT mydata.*, CRM.Country, CCM.[Sub Product UBR Code], CEM.FSI_LINE3_code FROM Data_SAP.dbo.mydata mydata INNER JOIN Data_SAP.dbo.[Country_Region Mapping] CRM ON (mydata.[Company Code] = CRM.[Company Code])INNER JOIN Data_SAP.dbo.[Cost Center mapping] CCM ON (mydata.[Cost Center] = CCM.[Cost Center])INNER JOIN Data_SAP.dbo.[Cost Element Mapping] CEM ON (mydata.[Unique Indentifier 1] = CEM.CE_SR_NO)WHERE CRM.Country IN (" & selection1 & ") AND CCM.[Sub Product UBR Code] IN (" & selection & ") AND CEM.FSI_LINE3_code IN (" & selection2 & ")AND mydata.year = '" & ComboBox4.Value & "' AND mydata.period = '" & ComboBox3.Value & "'AND mydata.[Document Type]= '" & Left(ComboBox11.Value, 2) & "' AND mydata.[Posting Date] between '" & DTPicker1.Value & "' AND '" & DTPicker3.Value & "'"
End If
Debug.Print cmd1.CommandText
Set Results = cmd1.Execute()
' Clear the data from the active worksheet
Cells.Select
Cells.ClearContents
' Add column headers to the sheet
headers = Results.Fields.Count
For iCol = 1 To headers
Cells(1, iCol).Value = Results.Fields(iCol - 1).Name
Next
' Copy the resultset to the active worksheet
Cells(2, 1).CopyFromRecordset Results
' Stop running the macro
MsgBox "Data Extraction Successfully Completed"
Unload Me
End Sub
Thanks a lot for your help in advance.:bow:
I have a macro which checks the existence of a particular text .i.e. Windows XP ID of a user in a sql database table and only then allows him to go ahead and run a macro, basically I wanted this macro for a authorization check. Now I have one more query .i.e. as below as of now I have put the above mentioned XP ID checking code in my userforms initiate event. Now I want to incorporate on more authorization check in my command button event. Following is the code which I have in initiate event of userform which works fine:
Private Sub UserForm_Initialize()
Dim strSQL As String
Dim strConnection_String As String
Dim x As String
'SQL String
strSQL = _
"SELECT XPUserID " _
& "FROM AuthorizedUserList " _
& "WHERE " _
& "XPUserID = '" & Environ("Username") & "';"
'Connection String to get data from an SQL Table
Dim connStr As String
Dim myservername As String
Dim mydatabase As String
Dim myuserid As String
Dim mypasswd As String
myservername = ThisWorkbook.Sheets(1).Cells(1, 3).Value
mydatabase = ThisWorkbook.Sheets(1).Cells(1, 5).Value
myuserid = ThisWorkbook.Sheets(1).Cells(1, 1).Value
mypasswd = ThisWorkbook.Sheets(1).Cells(1, 2).Value
strConnection_String = _
"Provider=SQLOLEDB.1;DRIVER=SQL Native Client;Password=" & mypasswd & ";Persist Security Info=false;User ID=" & myuserid & ";Initial Catalog=" & mydatabase & ";Data Source=" & myservername & ";"
x = CheckForAuthorizedUser(strConnection_String, strSQL)
If x <> "" Then
extractdataform.show
else
Msgbox "You don't have access to extract data sql macro"
End sub
'Other Module :
Function CheckForAuthorizedUser(ByVal strConnection_String As String, ByVal strSQL As String) As String
'Creates a recordset from SQL, using filter criteria from the calling sub
'Returns a name or an empty string
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
Now I have following code in my command button event. I have a Combobox on my userform .i.e. Combobox6 now this combobox gets populated with product codes Now I don't want to give access of all products to all users so what I am trying to do is I have sql table in my sql database .i.e AuthorizedUserList which contains 3 columns .i.e one is XPUserID, Name of the User and third is Product now I want to incorporate a line of code in my below commandbutton event which will check the product to which user has the access and only then it will allow him to extract the data for the same otherwise it will show a message that he doesn't have access to the Product which he has selected in Combobox6. Now what my macro will do is that it will get the windows xp user id of the user and on the basis of that it will get the product which is updated against same xpuser id in my "AuthorizedUserlist" table and then accordingly it allow user to extract the data. I have tried to write something from my end in the below commandbutton event but it doesn't work, I have highlighted the same in Red.
Private Sub CommandButton5_Click()
Workbooks.Add
'Selection String for Sub Product UBR Code
Dim selection As String
Dim lItem As Long
For lItem = 0 To ListBox4.ListCount - 1
If ListBox4.Selected(lItem) = True Then
selection = selection & "'" & Replace(Left(ListBox4.List(lItem), 6), "'", "''") & "',"
End If
Next
selection = Mid(selection, 1, Len(selection) - 1)
'Selection String For Country
Dim selection1 As String
Dim lItem1 As Long
For lItem1 = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(lItem1) = True Then
selection1 = selection1 & "'" & Replace(ListBox1.List(lItem1), "'", "''") & "',"
End If
Next
selection1 = Mid(selection1, 1, Len(selection1) - 1)
Dim selection2 As String
Dim lItem2 As Long
For lItem2 = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(lItem2) = True Then
selection2 = selection2 & "'" & Replace(Left(ListBox2.List(lItem2), 11), "'", "''") & "',"
End If
Next
selection2 = Mid(selection2, 1, Len(selection2) - 1)
' Setup connection string
Dim connStr As String
Dim myservername As String
Dim mydatabase As String
Dim myuserid As String
Dim mypasswd As String
myservername = ThisWorkbook.Sheets(1).Cells(1, 3).Value
mydatabase = ThisWorkbook.Sheets(1).Cells(1, 5).Value
myuserid = ThisWorkbook.Sheets(1).Cells(1, 1).Value
mypasswd = ThisWorkbook.Sheets(1).Cells(1, 2).Value
connStr = "Provider=SQLOLEDB.1;DRIVER=SQL Native Client;Password=" & mypasswd & ";Persist Security Info=false;User ID=" & myuserid & ";Initial Catalog=" & mydatabase & ";Data Source=" & myservername & ";"
' Setup the connection to the database
Dim connection As ADODB.connection
Set connection = New ADODB.connection
connection.ConnectionString = connStr
' Open the connection
connection.Open
' Open recordset.
Set cmd1 = New ADODB.Command
cmd1.ActiveConnection = connection
If cmd1.CommandText = "SELECT DISTINCT Product FROM AuthorizedUserList INNER JOIN Data_SAP.dbo.AuthorizedUserList ON (AuthorizedUserList.XPUserID = '" & Environ("Username") & "') WHERE Product = '" & Left(ComboBox6.Value, 6) & "';"
MsgBox "You are not authorized to extract data for the selected UBR / Cost Center Group"
Else
cmd1.CommandText = "SELECT mydata.*, CRM.Country, CCM.[Sub Product UBR Code], CEM.FSI_LINE3_code FROM Data_SAP.dbo.mydata mydata INNER JOIN Data_SAP.dbo.[Country_Region Mapping] CRM ON (mydata.[Company Code] = CRM.[Company Code])INNER JOIN Data_SAP.dbo.[Cost Center mapping] CCM ON (mydata.[Cost Center] = CCM.[Cost Center])INNER JOIN Data_SAP.dbo.[Cost Element Mapping] CEM ON (mydata.[Unique Indentifier 1] = CEM.CE_SR_NO)WHERE CRM.Country IN (" & selection1 & ") AND CCM.[Sub Product UBR Code] IN (" & selection & ") AND CEM.FSI_LINE3_code IN (" & selection2 & ")AND mydata.year = '" & ComboBox4.Value & "' AND mydata.period = '" & ComboBox3.Value & "'AND mydata.[Document Type]= '" & Left(ComboBox11.Value, 2) & "' AND mydata.[Posting Date] between '" & DTPicker1.Value & "' AND '" & DTPicker3.Value & "'"
End If
Debug.Print cmd1.CommandText
Set Results = cmd1.Execute()
' Clear the data from the active worksheet
Cells.Select
Cells.ClearContents
' Add column headers to the sheet
headers = Results.Fields.Count
For iCol = 1 To headers
Cells(1, iCol).Value = Results.Fields(iCol - 1).Name
Next
' Copy the resultset to the active worksheet
Cells(2, 1).CopyFromRecordset Results
' Stop running the macro
MsgBox "Data Extraction Successfully Completed"
Unload Me
End Sub
Thanks a lot for your help in advance.:bow: