I am new to Access and VBA trying to explore. I have a form where there is two text boxes(txtAc & txtFirstName), I want data to be populated in txtFirstName on the basis of SQL query based on parameter of txtAc. I tried to achieve the same by recordset. Please review my code below: -
Private Sub txtCust_Click()
Dim cnn As ADODB.Connection
Dim strSQL As String
Dim rst As ADODB.Recordset
Set cnn = CurrentProject.Connection
Dim i As Integer
Dim Records As Integer
Dim AcN As Double
Dim AcNo As Double
AcN = Forms!dfrmAccount!txtAc.Value
AcN = AcNo
strSQL = "SELECT dtblCustomer.[FIRST_N], dtblAccount.[ACCOUNT_NO] FROM
dtblAccount INNER JOIN dtblCustomer ON dtblAccount.[CUSTOMER_ID] =
dtblCustomer.[CUSTOMER_ID] WHERE (((dtblAccount.[ACCOUNT_NO])='AcNo'))"
Set rst = New ADODB.Recordset
rst.CursorLocation = adUseClient
rst.Open strSQL, cnn
Records = rst.RecordCount
Debug.Print rst.RecordCount
For i = 1 To Records
Me.txtFirstName.Value = rst.Fields!FIRST_N
Debug.Print rst.Fields!FIRST_N
rst.MoveNext
Next i
'' Clean up
rst.CLOSE
Set rst = Nothing
End Sub
Thanks in advance. Plz somebody help.
...(((dtblAccount.[ACCOUNT_NO])='AcNo'))"
should be
...(((dtblAccount.[ACCOUNT_NO])=" & AcNo & "))"
assuming ACCOUNT_NO is a numeric field.
You're also not populating AcNo - it will have the default value of zero.
Related
I need to get the max value from a column and store it at long varibale.
My VBA code :
Private Sub ADOFromExcelToAccessDstribute()
Dim dstibute_ID As Long
' get the next dstibute id
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim qry As String
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=W:\data\Database.accdb;jet
OLEDB:Database password=123;"
qry = "SELECT Max(distributeSummeryTable.distributeID) AS MaxOfdistributeID FROM
distributeSummeryTable;"
rst.Open qry, cnn, adOpenKeyset, adLockOptimistic
dstibute_ID = rst.MaxOfdistributeID
rst.Close
cnn.Close
'buile the export log
exportReportPacks
If (dstibute_ID = "" Or dstibute_ID = 0) Then
dstibute_ID = 1
End If
'add data to data base
ADOFromExcelToAccessDstributeSummeryTable (dstibute_ID)
ADOFromExcelToAccessFulldistributeSummeryTable (dstibute_ID)
End Sub
This is my database table and the field I want to return
I get an error in my code.
Info online and at StackOverflow didn't solve my issue.
SOLVED,
my syntax was wrong i should use ! insted of .
i try to store null value in long, it make error.
my change was :
If (rst!MaxOfdistributeID <> "") Then
dstibute_ID = rst!MaxOfdistributeID
End If
So I checked some examples and it seems there are a lot of peoples that populate forms from SQLinto excel but in my case, I have a multi selection Excel listBox that is linked with a Sql recordset.
Basically, I managed to send my full SQL recordset into my spreadsheet. It's a table (1500 rows,9 columns) and in my spreadsheet, Above this generated table I have 9 Listboxes, each Listbox should represents all the entries of its linked column.
I want to start simple and populate one column into my excel Listbox so that users can just select whatever entry(ies) they want into the listbox. My problem is that I don't find the right ListBox method to display my entries. Here is my code so far:
Populating the recordset into SQL (That is working for whom who need this):
Sub Get_Datas_From_SQL()
Dim mobjConn As ADODB.Connection
Dim strConn As String
Set mobjConn = New ADODB.Connection
Dim strSQL As String
strConn = "Provider=SQLOLEDB; Data Source=My_server;" _
& "Initial Catalog=My_db;Integrated Security=SSPI;"
mobjConn.Open strConn
Dim rs As ADODB.Recordset
Dim Rn As Range
Set rs = New ADODB.Recordset
Set Rn = My_sheet.Range("A20")
My_sheet.Range(Rn, Rn.Offset(2000, 20)).ClearContents
strSQL = "SELECT * FROM Stocks_table"
With rs
.ActiveConnection = mobjConn
.Open strSQL
Rn.CopyFromRecordset rs
.Close
End With
mobjConn.Close
Set rs = Nothing
End Sub
Now, as a start, I add the code that is supposed to populate one of the nine Listboxes
Sub init_()
Dim mobjConn As ADODB.Connection
Dim strConn As String
Set mobjConn = New ADODB.Connection
Dim strSQL As String
strConn = "Provider=SQLOLEDB; Data Source=My_server;" _
& "Initial Catalog=My_db;Integrated Security=SSPI;"
mobjConn.Open strConn
strSQL = "SELECT DISTINCT Currency FROM Stocks_table "
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
With rs
.ActiveConnection = mobjConn
.Open strSQL
Dim a()
a = rs.GetRows
?
.Close
End With
End Sub
I took some remarks into account from previous questions and I'll get back to potential answers a fast as possible !
Thanks a lot in advance and have a great day
When you use the GetRows-method of a recordset, the data will be put into a 2-dimensional array. What's a little bit counter-intuitive is that the first index is the index into fields and the second is the index into the rows of the recordset.
You can assign a 2-dimensional array to the List-property of a listbox - but the first index needs to be the row and the second the field number (if you deal with a multi-column listbox). So all you need to do is to transpose the array before assigning it:
a = rs.GetRows
shtEquity.ListBoxCcy.List = Application.WorksheetFunction.Transpose(a)
For those who want to know, here is the answer:
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
With rs
.ActiveConnection = mobjConn
.Open strSQL
Dim a
a = rs.GetRows
For Each Row In a
shtEquity.ListBoxCcy.AddItem Row
Next
.Close
End With
a = Rs.GetRows
Worksheets(1).Shapes(1).ControlFormat.List = a 'control ListBox
Worksheets(1).OLEObjects(1).Object.List = WorksheetFunction.Transpose(a) 'Oleobject listbox
if your Listbox is MSForms.ListBox then refer below.
Dim Ws As Worksheet
Dim oleObjt As MSForms.ListBox
Set Ws = Worksheets(1)
Set oleObjt = Ws.OLEObjects("ListBox1").Object 'Ws.OLEObjects(1).Object
oleObjt.Clear
oleObjt.List = WorksheetFunction.Transpose(a)
Control & Oleobject image
I have a small issue, I am trying to code a Macro for Autocad in VBA.
I am trying to read a certain column value through sending a SQL native query that connects to the database server.
The problem is that my String variable descToReturn that's going to hold a value of that column is returning null. I can't seem to figure out where I am wrong. So if anyone can advise that'd be great.
Here's the code below:
Private Sub btnDuplicate_Click()
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim ConnectionString As String
Dim StrQuery As String
Dim BOMLineToCheck As AcadBlockReference
Dim BOMAttributes As Variant
Dim partNoToCheck As String
Dim i As Integer
Dim descToReturn As String
ConnectionString = "Provider=SQLxxxxx.1;Password=xxxx;Persist Security Info=True;User ID=xxxx;Data Source=xx\xx;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Use Encryption for Data=False;Tag with column collation when possible=False;Initial Catalog=xxx_xxx"
Set cnn = New ADODB.Connection
cnn.ConnectionString = ConnectionString
cnn.Open
'cnn.CommandTimeout = 900
Set rst = New ADODB.Recordset
StrQuery = "SELECT * FROM [My Table Name] WHERE [My Column]='partNoToCheck'"
For Each BOMLineToCheck In ThisDrawing.ModelSpace
If BOMLineToCheck.Name = "BOM3LINE_old" Then
BOMAttributes = BOMLineToCheck.GetAttributes()
For i = 0 To UBound(BOMAttributes)
If BOMAttributes(i).TagString = "PART#" Then
partNoToCheck = BOMAttributes(i).TextString
End If
Next i
End If
rst.Open StrQuery, cnn, adOpenDynamic
With rst
If Not .EOF Then
descToReturn = rst![My Coulmn]
End If
End With
rst.Close
MsgBox descToReturn
Next
End Sub
Look closely for a typo:
descToReturn = rst![My Coulmn]
You probably mean:
descToReturn = rst![My Column]
See the difference?
So, I found the answer, because I am bringing SQL within VBA environment, the syntax was not right and its a weird syntax:
correct Syntax for SQL query:
StrQuery = "SELECT * FROM [My Table] WHERE [My Column]= '" & partNoToCheck & "'"
Situation :
I have this code which stores all the records from the field Shipment ID in an array called arrayShipmentID.
Dim conn As New ADODB.Connection
Dim connStr As String
Dim rs As ADODB.Recordset
Dim ShipmentIDSQL As String
Dim arrayShipmentID() As Variant
connStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & "P:\PathToTheAccessDatabase\" & "NewVersion.accdb" & ";"
conn.ConnectionString = connStr
conn.Open
' Store Shipment IDs
Set rs = New ADODB.Recordset
ShipmentIDSQL = "SELECT [Shipment ID] FROM 12Dec"
rs.Open ShipmentIDSQL, conn, adOpenStatic, adLockReadOnly, adCmdText
If Not rs.EOF Then
arrayShipmentID = rs.GetRows
End If
Dim i As Integer
For i = 0 To UBound(arrayShipmentID, 2)
Debug.Print arrayShipmentID(0, i)
Next i
Set rs = Nothing
In order to make sure it works I Debug.Print each element of the array.
Issue :
This code WORKS most of the time, but for some reason, sometimes I get as a value 'subscript out of range' (instead of 181 in my case) for MsgBox UBound(arrayShipmentID, 2) and of course in that case Debug.Print doesn't display anything in the Immediate Window.
Any ideas where could this come from ?
With DAO recordsets you often have to find the recordcount to retrieve all records. That might be the case for ADO as well:
RecordCount = ' Obtain true count of records.
arrayShipmentID = rs.GetRows(RecordCount)
Also, I normally declare the variable as a simple Variant:
Dim arrayShipmentID As Variant
What do I need to add/modify to this code to have txtDisease1 be populated with the results of strSQL? As of now the textbox populates with the SQL query. I'm sure it is a simple fix but for the life of me I can not find the answer.
Private Sub btnDNA_Click()
Dim strSQL As String
strSQL = "SELECT LastName From Patient WHERE PatientID = 1"
Me.txtDisease1.Value = strSQL
End Sub
You can use DLookup function.
Me.txtDisease1.Value = DLookup("LastName", "Patient", "PatientID = 1")
I've not been able to test this, but I think this should work.
Private Sub btnDNA_Click()
Dim strSQL As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
strSQL = "SELECT LastName From Patient WHERE PatientID = 1"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
Me.txtDisease1 = rs!LastName
rs.close
Set rs = Nothing
Set db = Nothing
End Sub
For more complex lookups or to hit other data sources, you can use ADO (requires reference to Microsoft Active X Data Objects)
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open "SELECT TOP 1 LastName From Patient WHERE PatientID=1", _
CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
If Not rs.EOF Then Me.txtDisease1.Value = rs(0)
rs.Close
Set rs = Nothing