Get 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
    
    [B][COLOR=Red]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"[/COLOR][/B]
    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.

 

[xenou]

Start with one selection item and a simpler query without joins. Work out the bugs. Take from there - one step at a time, one piece at at time, until all the selection items and all the joins are working.

If you start with a long and complex query you only make it harder for yourself. If you build up piece by piece you will know exactly when something you've just tried doesn't work - and what it is that broke.

Also, posting the sql string as generated by the code is important for debugging. No one can help you if we don't know what all the variable are and how they look in the actual SQL string generated by your code.