problem with getting value into a string using sql statement in VBA.

[abhay_547]

Hi All,

I have excel userform which extracts data from a sql server database on basis of the parameters selected by users on the userform.

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, second is 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. Please help...

Private Sub CommandButton5_Click()

'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 & ";"
Dim startdate As String
Dim enddate As String
Dim startdate1 As String
Dim enddate1 As String

startdate = Format(DTPicker1.Value, "MM/dd/yyyy")
enddate = Format(DTPicker3.Value, "MM/dd/yyyy")
startdate1 = Format(DTPicker4.Value, "MM/dd/yyyy")
enddate1 = Format(DTPicker5.Value, "MM/dd/yyyy")

   
    ' 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
   
    Dim sSQL As String
    sSQL = "SELECT DISTINCT Product FROM Data_SAP.dbo.AuthorizedUserList WHERE AuthorizedUserList.XPUserID = '" & Environ("Username") & "' AND AuthorizedUserList.Product = '" & Left(ComboBox6.Value, 6) & "';"
    Debug.Print sSQL
    If sSQL <> Left(ComboBox6.Value, 6) Then
    Msgbox "You don't have access to selected product"
    Else
    Workbooks.Add
    If CheckBox5.Value = True And CheckBox6.Value = True And CheckBox7.Value = True Then
    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 '" & startdate & "' AND '" & enddate & "'"
    ElseIf CheckBox5.Value = False Or CheckBox6.Value = False Or CheckBox7.Value = False Then
    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 between '" & ComboBox2.Value & "' AND '" & ComboBox3.Value & "'"
    End If
    Debug.Print cmd1.CommandText
    Set Results = cmd1.Execute()

If Results.EOF Then
        ' Recordset is empty
        MsgBox "No Records Found"
        Debug.Print cmd1.CommandText
    Else

   

    ' Clear the data from the active worksheet
    Cells.Select
    Cells.ClearContents

    While Not Results.EOF

        ' 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
Dim MaxRows As Long
Dim ws As Worksheet
Set ws = ActiveSheet
MaxRows = ws.Rows.Count - 1
        ' Copy the resultset to the active worksheet
        'Cells(2, 1).CopyFromRecordset Results, 65536
        ws.Cells(2, 1).CopyFromRecordset Results, MaxRows
        'add another sheet if we're not at the end of the recordset
        If Not Results.EOF Then Set ws = ws.Parent.Worksheets.Add(After:=ws)
       
    Wend

End If
    ' Stop running the macro
MsgBox "Data Extraction Successfully Completed"
 
    Unload Me
End Sub

Thanks a lot for your help in advance.

[Hack]

You are making this more difficult that it has to be.

Question: Why are you adding all products to the combo if all users don't have access to all products.

Before you load anything, grab the user Id, and the load in the combo ONLY those products to which the user has access.

Now, you don't have to filter anything.

[abhay_547]

Hi Hack,

Thanks a lot for your reply, I got your point and following is the code which I am using to load products in the combobox6 can you please help me with the same.

Private Sub ComboBox6_Click()

Dim sSQL As String
Set adoRS = New ADODB.Recordset
If ComboBox6.Value <> "All" Then
sSQL = "SELECT DISTINCT [Sub Product UBR Code]+'~'+[Sub Product / UBR] FROM [Cost Center Mapping] WHERE [Product UBR code] = '" & Left(ComboBox6.Value, 6) & "'"
Else
sSQL = "SELECT DISTINCT [Sub Product UBR Code]+'~'+[Sub Product / UBR] FROM [Cost Center Mapping]"
End If
adoRS.Open sSQL, ADOCn
ListBox4.Clear
Do While Not adoRS.EOF
ListBox4.AddItem adoRS(0)
ListBox4.Selected(ListBox4.ListCount - 1) = True
adoRS.MoveNext
Loop
adoRS.Close
Set adoRS = Nothing

End Sub

And apart from this following is the code which I had used in the command button event.

 Dim sSQL As String
    sSQL = "SELECT DISTINCT Product FROM Data_SAP.dbo.AuthorizedUserList WHERE AuthorizedUserList.XPUserID = '" & Environ("Username") & "' AND AuthorizedUserList.Product = '" & Left(ComboBox6.Value, 6) & "';"
    Debug.Print sSQL
    If sSQL <> Left(ComboBox6.Value, 6) Then
    Msgbox "You don't have access to selected product"
    Else
'Rest of the code
End if 
End sub

As a second thought but is it not actually possible to populate combobox 6 with all products and then allow users to extract data for only those products to which they have access.

Thanks a lot for your help in advance.

[Hack]

Whatever you use to load the combo needs a WHERE for the authorized products = the logged in id