How to populate a text box from a listbox? - excel

I have a listbox with combined Employee Number and Name. so what you see is 0001-John Doe but now when I try and populate a text box with the list box info it does not work.
How I populate my listbox:
Private Sub UserForm_Initialize()
Dim conn As New ADODB.Connection
Dim rsst As New ADODB.Recordset
dbPath = Sheets("Info").Range("a2").Value
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
rsst.Open "SELECT EmpNumber,EmpFirstName,EmpSurname FROM Employees;", _
conn, adOpenStatic
With rsst
.MoveFirst
Do Until .EOF
Me.lbxNextOfKinEmployeeNumber.AddItem rsst.Fields(0).Value & " - " & rsst.Fields(1) & " " & " " & rsst.Fields(2) & " "
rsst.MoveNext
Loop
End With
End Sub
What's in my view button:
Private Sub btnNextOfKinSelect_Click()
Dim CNOK As New ADODB.Connection
Dim RNOK As New ADODB.Recordset
txtNextofKinEmployeeNumber.Enabled = False
'btnEditNextOfKin.Visible = True
If lbxNextOfKinEmployeeNumber.ListIndex = -1 Then
MsgBox "Please Select a Employee Number"
Else
dbPath = Sheets("Info").Range("a2").Value
CNOK.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
RNOK.Open "SELECT * FROM EmployeeNextOfKin Where EmpNumber ='" &
Me.lbxNextOfKinEmployeeNumber & "'", _
CNOK, adOpenStatic
RNOK.MoveFirst
txtNextofKinEmployeeNumber.Value = RNOK("EmpNumber")
txtNextOfKinName.Value = RNOK("NextOfKinName")
txtNextOfKinSurname.Value = RNOK("NextOfKinSurname")
txtContactNumber.Value = RNOK("NextofKinContactNumber")
txtContactAddressLine1.Value = RNOK("NextofKinAddress")
txtNextofKinCity.Value = RNOK("NextofKinCity")
txtCellNumber.Value = RNOK("NextofKinCellNumber")
End If
End Sub
What I want is when I select 0001-John Doe it should get the data from my database and populate my textboxes.

Code is trying to match concatenated string 0001-john doe with EmpNumber field value 0001. Options:
set listbox RowSource as multi-column
Do Until rsst.EOF
With Me.lbxNextOfKinEmployeeNumber
.ColumnCount = 2
.ColumnWidths = "0;2"
.AddItem rsst(0) & ";" & rsst(0) & " - " & rsst(1) & " " & rsst(2)
End With
rsst.MoveNext
Loop
If users would prefer to type name, don't include EmpNumber in concatenated string. Last name first might be more appropriate:
.AddItem rsst(0) & ";" & rsst(2) & ", " & rsst(1)
Might want to sort recordset: ORDER BY EmpSurname
extract EmpNumber from concatenated string
Left(Me.lbxNextOfKinEmployeeNumber, 4)
use LIKE and wildcard
WHERE '" & Me.lbxNextOfKinEmployeeNumber & "' LIKE [EmpNumber] & '*'"

Related

Transposing Values In a Listbox

Good day,
I am trying to transpose the values added to my listbox via a query. Also does anyone have tips on how to get the column names on the Column Header. This is what the values in my listbox looks like:
Below is my code thus far:
Dim conn As New ADODB.Connection
Dim reCs As ADODB.Recordset
Dim tarSheet As Worksheet
Dim strbooK As String, strTar As String
Dim arTar As Range
strbooK = ThisWorkbook.Path & "\Excel_VBA.xlsm"
If opTar.Value = True Then
strTar = "SELECT TargetNumber as [Target Number] " & _
",TargetName as [Target Name] " & _
",TargetPrefix as [Target Nickname] " & _
",Count(TargetNumber) as [Number of Events] " & _
"FROM [Master$] " & _
"GROUP BY TargetNumber, TargetName, TargetPrefix " & _
"HAVING TargetNumber = '" & txt_search.Value & "';"
Set conn = New ADODB.Connection
conn.ConnectionString = _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strbooK & ";" & _
"Extended Properties='Excel 12.0 Xml;HDR=YES';"
conn.Open
Set reCs = New ADODB.Recordset
reCs.ActiveConnection = conn
reCs.Source = strTar
reCs.Open
With lbx_reCs
.BoundColumn = 1
.ColumnCount = 4
.ColumnHeads = True
.TextAlign = fmTextAlignCenter
.ColumnWidths = "136;136;136;136;"
.MultiSelect = fmMultiSelectMulti
' .RowSource = arTar.Address
.List() = reCs.GetRows
End With
'Releasing Objects
reCs.Close
conn.Close
End If
Thank you
As said in the titel you need no transpose of the values of the recordset, just use the column property of the listbox.
.Column = reCs.GetRows
For the other question you might look here. That seems not to be possible in case you have an array like in this case. On the other hand you also might want to look at this solution approach in the above mentioned post.

Query fails inside loop (returns EOF)

My query works fine outside of the loop when I have the hard-coded values in. When I put the query inside my loop and use variables to hold the correct values it returns EOF. I've printed out the query and run it directly in SQL server and it returns the correct results. Which makes me think my SQL syntax is ok, but I can't figure out why it doesn't return anything in the loop. Any Ideas?
Public Function getPOs()
Dim TotalPos, Curpo, Query, ClaimNum, Color, DCloc As String
Dim i As Integer
Dim Row, Style, LastRow As LongPtr
Dim ws As Worksheet
Set ws = Worksheets("test")
' Set up database connection
Dim cnn As ADODB.Connection
Dim rs As New ADODB.Recordset
Set cnn = New ADODB.Connection
cnn.ConnectionString = SQL_SERVER_CONNECTION
cnn.ConnectionTimeout = 0
cnn.CommandTimeout = 0
cnn.Open
'This query works fine, it returns results that I can iterate through.
rs.Open "SELECT PO " & _
"FROM [catalog].[dbo].[table] " & _
"WHERE CLAIM_NUMBER = '1337' AND STYLE = '293493' and COLOR = '03' AND DC_LOCATION = 'PFC'", cnn, adOpenDynamic, adLockOptimistic
' Itereate through the results
i = 0
Do While Not rs.EOF
If rs![PO] = "" Then
Exit Do
End If
If i = 0 Then
Curpo = rs![PO]
TotalPos = Curpo
Else
Curpo = rs![PO]
TotalPos = TotalPos & ", " & Curpo
End If
i = i + 1
rs.MoveNext
Loop
MsgBox TotalPos ' Works fine!
' For some reason adding the query inside this loop messes it up.
Row = 11
LastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
rs.Close
While Row < 12 ' will change back to LastRow once working
'Parse the claim number
ClaimNum = Replace(ws.Cells(Row, 10), "IC - ", "")
MsgBox ClaimNum
'Style
Style = Left(ws.Cells(Row, 11), Len(ws.Cells(Row, 11)) - 2)
MsgBox Style
'Color
Color = ws.Cells(Row, 12)
MsgBox Color
'DCloc
DCloc = ws.Cells(Row, 13)
MsgBox DCloc
' When I add the query here it returns nothing...
rs.Open "SELECT PO " & _
"FROM [catalog].[dbo].[table] " & _
"WHERE CLAIM_NUMBER = " & ClaimNum & " AND STYLE = " & Style & " and COLOR = '" & Color & "' AND DC_LOCATION = ' " & DCloc & "'", cnn, adOpenDynamic, adLockOptimistic
'add the entire sql statement to the Query var so I can print it out and run it in SQL Server
Query = "SELECT PO " & _
"FROM [catalog].[dbo].[table] " & _
"WHERE CLAIM_NUMBER = " & ClaimNum & " AND STYLE = " & Style & " and COLOR = '" & Color & "' AND DC_LOCATION = '" & DCloc & "'"
' print the query... when I run this exact thing in SQL server it returns results just fine'
MsgBox Query
' iterate through results
i = 0
'rs.EOF now that it's in the loop... but why? I know the syntax of the query is correct, it returns results when I run it directly in SQL server
If rs.EOF Then
MsgBox "why???"
End If
Do While Not rs.EOF
If rs![PO] = "" Then
Exit Do
End If
If i = 0 Then
Curpo = rs![PO]
TotalPos = Curpo
Else
Curpo = rs![PO]
TotalPos = TotalPos & ", " & Curpo
End If
MsgBox TotalPos
i = i + 1
rs.MoveNext
Loop
rs.Close
Row = Row + 1
Wend
cnn.Close
End Function
rs.Open "SELECT PO " & _
"FROM [catalog].[dbo].[table] " & _
"WHERE CLAIM_NUMBER = " & ClaimNum & " AND STYLE = " & Style & " and COLOR = '" & Color & "' AND DC_LOCATION = ' " & DCloc & "'"
Don't concatenate parameter values into your SQL string - that way you don't need to care about quoting strings and worry about whether a string contains apostrophes, or worse - the widely-known tale of Little Bobby Tables captures just how impactful this careless value concatenation practice can be, if you let it.
Instead, define your query once, and let the server deal with the parameters (it's its job).
Const sql As String = _
"SELECT PO " & _
"FROM [catalog].[dbo].[table] " & _
"WHERE CLAIM_NUMBER = ? AND STYLE = ? AND COLOR = ? AND DC_LOCATION = ?"
Each ? is understood by ADODB as a positional parameter: all you need to do now, is to execute a ADODB.Command with 4 parameters, appended in the order they are specified.
Now you can write a Function that takes the values for the 4 parameters you need, and the function can return a ADODB.Recordset that contains the results - no need to redefine the SQL string every time you need it!
Private Function GetPO(ByVal cnn As ADODB.Connection, ByVal ClaimNum As String, ByVal Style As String, ByVal Color As String, ByVal DCloc As String) As ADODB.Recordset
Const sql As String = _
"SELECT PO " & _
"FROM [catalog].[dbo].[table] " & _
"WHERE CLAIM_NUMBER = ? AND STYLE = ? AND COLOR = ? AND DC_LOCATION = ?"
Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
Set cmd.ActiveConnection = cnn
cmd.CommandType = adCmdText
cmd.CommandText = sql
'TODO: verify parameter types & sizes - here NVARCHAR(200).
'NOTE: parameters must be added in the order they are specified in the SQL.
cmd.Parameters.Append cmd.CreateParameter(Type:=adVarWChar, Size:=200, Value:=ClaimNum)
cmd.Parameters.Append cmd.CreateParameter(Type:=adVarWChar, Size:=200, Value:=Style)
cmd.Parameters.Append cmd.CreateParameter(Type:=adVarWChar, Size:=200, Value:=Color)
cmd.Parameters.Append cmd.CreateParameter(Type:=adVarWChar, Size:=200, Value:=DCloc)
Set GetPO = cmd.Execute
End Function
You can use it from anywhere you have an ADODB.Connection that's ready to use:
Dim rs As ADODB.Recordset
Set rs = GetPO(cnn, ClaimNum, Style, Color, DCloc)
Do While Not rs.EOF
'...
Loop
You need to wrap variables in quotes to make it work, a string type isn't enough.
"WHERE CLAIM_NUMBER = " & ClaimNum & " ...
Needs to become:
"WHERE CLAIM_NUMBER = " & "'" & ClaimNum & "'" & " ...
In addition to all the other variables you are concatenating into the SQL statement
As an aside
Dim TotalPos, Curpo, Query, ClaimNum, Color, DCloc As String
is only declaring DCloc as a string and all the others are variants.
To make them all string you need to add as string to all of them.
Dim TotalPos as string, Curpo as string, Query as string, ClaimNum as string, Color as string, DCloc As String

how to retrieve data from access to excel using vba?

I am trying to retrieve data from access using excel-vba but the problem is when i want to use an AND in SQL query it throws an error.
This works
SQL = "SELECT " & col_name & " FROM PhoneList WHERE Item LIKE '" & var & "%" & "'"
This doesn't
SQL = "SELECT " & col_name & " FROM PhoneList WHERE Item LIKE '" & item & "%" & "'" & " AND Size Like '" & size & "%" & "'"
even this doesn't work
SQL = "SELECT Standard FROM PhoneList WHERE Item = 'Shank Button' AND Size = '17'"
This throws an
error -2147467259 Method 'open'object' _recordset' failed
from excel where it works fine if I try it in access query
SELECT Standard FROM PhoneList WHERE Item = 'Shank Button' AND Size = '17'
here is my table [PhoneList] structure
ID | Item | Size | Standard | Customized Standard | Premium | Customized Premium
here, the combination of Item and Size makes a record unique.
I assume only AND part is creating the problem or something is wrong with recordset pasting to the excel sheet.
I am trying to retrieve only one value from DB where Item, size and category type (Standard or Customized Standard or Premium) will be taken from excel userform's combobox, and I will show that value in a cell or in a textfield.
Any help will be highly appreciated.
here is my code ...
Option Explicit
Private Sub CommandButton1_Click()
'Declaring the necessary variables.
Dim cnn As ADODB.Connection 'dim the ADO collection class
Dim rs As ADODB.Recordset 'dim the ADO recordset class
Dim dbPath As String
Dim SQL As String
Dim i As Integer
Dim item As String
'add error handling
On Error GoTo errHandler:
'Disable screen flickering.
Application.ScreenUpdating = False
'Clear the old data
Sheet2.Range("A2:G10000").ClearContents
'Variables
dbPath = Sheet1.Range("I3").Value
item = ComboBox1.Text
'Initialise the collection class variable
Set cnn = New ADODB.Connection
'Connection class is equipped with a —method— named Open
'—-4 aguments—- ConnectionString, UserID, Password, Options
'ConnectionString formula—-Key1=Value1;Key2=Value2;Key_n=Value_n;
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
'Create the SQL statement to retrieve the data from table.
Dim col_name As String
Dim Isize As String
Isize = "17"
col_name = ComboBox3.Text
If Sheet2.Range("J2").Value = "Yes" Then
SQL = "SELECT * FROM PhoneList WHERE Item = '" & item & "'"
Else
SQL = "SELECT " & col_name & " FROM PhoneList WHERE Item LIKE '" & item & "%" & "'" & " AND Size LIKE '" & Isize & "%" & "'"
'SQL = "SELECT " & col_name & " FROM PhoneList t WHERE t.Item LIKE '" & item & "*' AND t.Size = " & size
End If
'Create the ADODB recordset object.
Set rs = New ADODB.Recordset 'assign memory to the recordset
'ConnectionString Open '—-5 aguments—-
'Source, ActiveConnection, CursorType, LockType, Options
rs.Open SQL, cnn
'Check if the recordset is empty.
If rs.EOF And rs.BOF Then
'Close the recordet and the connection.
rs.Close
cnn.Close
'clear memory
Set rs = Nothing
Set cnn = Nothing
'Enable the screen.
Application.ScreenUpdating = True
'In case of an empty recordset display an error.
MsgBox "There are no records in the recordset!", vbCritical, "No Records"
Exit Sub
End If
'Write the reocrdset values in the sheet.
Sheet2.Range("a2").CopyFromRecordset rs
'Close the recordset and the connection.
rs.Close
cnn.Close
'clear memory
Set rs = Nothing
Set cnn = Nothing
'Update the worksheet
Application.ScreenUpdating = True
'Inform the user that the macro was executed successfully.
MsgBox "Congratulation the data has been successfully Imported", vbInformation, "Data Imported"
On Error GoTo 0
Exit Sub
errHandler:
'clear memory
Set rs = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Import_Data"
End Sub
Thanks
There should be a space before the AND:
SQL = "SELECT " & col_name & " FROM PhoneList WHERE Item LIKE '" & item & "%" & "'" & " AND Size Like '" & item & "%" & "'"
There are a few issues here -
MS Access uses the asterisk * as the wildcard character to represent any sequence of characters (or no characters), not the percent symbol % used by some other RDBMS.
size is a reserved word in MS Access and so could potentially cause problems unless enclosed in square brackets or prefixed with the table qualifier.
Assuming the Size field is numerical (as the name would imply), you should not surround the value with single quotes, hence the code might become:
SQL = "SELECT " & col_name & " FROM PhoneList t WHERE t.Item LIKE '" & item & "*' AND t.Size = " & size

ADO ACE OLEDB 12.0 Excel Front end with VBA troubleshooting

I am using Excel 2013 as a front end application written w/ VBA.
I've linked a XLSX file inside an Access 2013 database in order to use SQL simply for example to read MAX Value of a column of which datas are filtered with a Where Clause.
I cannot understand why a SQL statement for retrieving MAX value does not work whereas the same statement is OK via SQL Querying in Access.
Hereafter VBA code excerpt :
varCnxStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" &
G_sWBookREINVOICingFilePath & ";Mode="
With conXLdb
'*
'.Provider = "Microsoft.ACE.OLEDB.12.0"
'.ConnectionString = "Data Source=" & G_sWBookREINVOICingFilePath & ";"
& "Extended Properties='Excel 12.0;HDR = YES'"
'.Mode = adModeShareExclusive
.Open varCnxStr & adModeShareExclusive
'*
End With
Debug.Print varCnxStr & adModeShareExclusive
strSQL = "SELECT MAX(InvoiceNum) as LastNumInvoice"
strSQL = strSQL & " FROM ReInvoiceDB "
strSQL = strSQL & " WHERE InvoiceNum > " & strYMPrefix_p & "000"
strSQL = strSQL & ";"
Debug.Print strSQL
adoXLrst.Open Source:=strSQL, ActiveConnection:=conXLdb,
CursorType:=adOpenStatic, LockType:=adLockOptimistic, Options:=adCmdText
adoXLrst.MoveFirst
'Set adoXLrst = conXLdb.Execute(strSQL)
HighestStr = adoXLrst![LastNumInvoice]
adoXLrst.Close
strGSFNumber = HighestStr '>> byref returning value
conXLdb.Close
Veloma:
'>>
On Error Resume Next
Set adoXLrst = Nothing
Set conXLdb = Nothing
Exit Sub
'>>
Diso:
Beep
Beep
'>>
strGSFNumber = "ERR"
'>>
sMsg = "pG_getNEXTInvoiceValueXLasDB-ERR ::" & Err.Number & ":: - " &
Err.Description
MsgBox sMsg, vbOKOnly + vbCritical
sRet = sMsg
Resume Veloma
End Sub
It returns Null value in variable HighestStr whereas it should receive a double value ...
Any help or any clue on misfunctionning ?
Regards.

VBA ADODB update recordset

I am trying to read the contents of two different tabs in a worksheet and compare them by using ADODB and querying techniques VBA.
Below you can find my code:
stCon = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & wbBook.FullName & ";" _
& "Extended Properties=""Excel 8.0;HDR=YES;IMEX=1;Readonly = False"";"
' MsgBox (stCon)
'here is SQL code to gather data including our calculation from two tables within the workbook
'stSQL = "SELECT [Recon_Daily_Xml_report$].RECTYPEGLEDGER, [GL_Activity_totals$].TRXNTYPE, ([Recon_Daily_Xml_report$].Amount_Abs - [GL_Activity_totals$].BILLINGAMT) as Amount_Diff ,"
'stSQL = stSQL & " ([Recon_Daily_Xml_report$].NUMOFENTRIES - [GL_Activity_totals$].NUMOFTRXNS) as Count_Diff "
'stSQL = stSQL & " FROM [Recon_Daily_Xml_report$], [GL_Activity_totals$]"
'stSQL = stSQL & " WHERE Lower([Recon_Daily_Xml_report$].RECTYPEGLEDGER) = Lower([GL_Activity_totals$].TRXNTYPE)"
'stSQL = stSQL & " ORDER BY [Recon_Daily_Xml_report$].RECTYPEGLEDGER ASC"
stSQL = "SELECT LCASE([GL_Activity_totals$].TRXNTYPE),Sum(ABS([GL_Activity_totals$].BILLINGAMT)),Sum([GL_Activity_totals$].NUMOFTRXNS) "
stSQL = stSQL & " FROM [GL_Activity_totals$] "
stSQL = stSQL & " Group By [GL_Activity_totals$].TRXNTYPE "
stSQL = stSQL & " ORDER BY [GL_Activity_totals$].TRXNTYPE ASC"
'MsgBox (stSQL)
Set cnt = New ADODB.Connection
Set rst = New ADODB.Recordset
cnt.Open stCon
'rst.Open stSQL, cnt, 1, 3
rst.Open stSQL, cnt, adOpenStatic, adLockOptimistic
'rst.Open strSQL, cnt, adOpenStatic, adLockOptimistic
With rst
Do While Not .EOF
If rst.Fields.Item(0).Value <> "" Then
strString = Replace(rst.Fields.Item(0).Value, " ", " ")
rst.Update
rst.Fields.Item(0) = strString
End If
.MoveNext
Loop
End With
This specific code gives me back an error suggesting that I cannot update the field in the recordset I want to update when reading it. The error I am currently getting is:
Run-time error '-2147217911 Cannot update. Database or object is read-only.
Tried to change the way i open the recordset by using 1,3 option but again i was getting the same error.
Can anyone help with this?
The issue is with
LCASE([GL_Activity_totals$].TRXNTYPE)
and with the GROUP BY.
In this case, rst.Fields.Item(0) is an expression, not a table value. You can't update expressions. Also, since you're using GROUP BY, the recordset is not linked to any particular record for access to edit. You could accomplish the same task purely in SQL
cnt.Execute("UPDATE [GL_Activity_totals$] " & _
" SET [GL_Activity_totals$].TRXNTYPE = Substitute([GL_Activity_totals$].TRXNTYPE,' ', ' ') " & _
" WHERE NOT [GL_Activity_totals$].TRXNTYPE IS NULL " & _
" AND [GL_Activity_totals$].TRXNTYPE <> '';")

Resources