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...

[VBA]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[/VBA]

Thanks a lot for your help in advance.

[xlbo]

your basic issue is that you have not executed the SQL against the connection so you have nothing to check against.

you need to add something like

dim rsRecset as ADODB.recordset
set rsRecSet = connection.execute(sSQL)

then check to see if the recordset has any data returned....however.....

Rather than try to process this after the user has selected a product, why not populate the combobox based on the producst available?

In the form load event, execute your SQL statement and iterate through the recordset to add the items to the combobox

[VBA]
Dim connection As ADODB.connection
Set connection = New ADODB.connection
connection.ConnectionString = connStr
' Open the connection
connection.Open

' Open recordset.
Dim sSQL As String
sSQL = "SELECT DISTINCT Product FROM Data_SAP.dbo.AuthorizedUserList WHERE AuthorizedUserList.XPUserID = '" & Environ("Username") & "';"

dim rsRecset as ADODB.recordset
set rsRecset = connection.execute(sSQL)

rsRecset.movefirst

Do while not rsrecset.eof

combobox6.additem rsrecset.fields(0).value

rsrecset.movenext

Loop
[/VBA]