How to retrieve data from access database with serial no. using vba? - vba

I have a excel workbook and a access database. See below image: -
Is there any way or method to retrieve data from access database to excel sheet by there serial number.
For example
if I type 16 in sr. no. field then all related cell should be populate with their related data.
Like
Company: Mayank
Location: Shimla
Contact: 6325859647
Descriptions, Quantity, Rate Total etc.
As shown in image.
or if i type 15 in serial number field then
Details Should Be Like
Company: Samar
Location: Bhiwari
Contact: 6325859647
Descriptions, Quantity, Rate Total
etc.
Below code is for retrieve data between two dates.
Sub Demo()
Dim cn As Object, rst As Object
Dim sDate As Date, eDate As Date
Dim strQuery As String
Set cn = CreateObject("ADODB.Connection")
sDate = DateSerial(2006, 3, 30)
eDate = DateSerial(2006, 4, 25)
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=C:\Test\Northwind.accdb"
.Open
End With
strQuery = "SELECT * FROM [Inventory Transactions] Where [Transaction Created Date] Between #" & sDate & "# and #" & eDate & "#"
Set rst = CreateObject("ADODB.Recordset")
rst.Open strQuery, cn, 1, 3
[A1].CopyFromRecordset rst
rst.Close
cn.Close
End Sub
Any Help will be appreciates.

Related

Issue Writing/Reading Dates when using MS Excel VBA to MS ACCESS Database

I'm developing an app in MS Excel (2019) in which I'm trying to write/read a date to MS Access (2019, same suite) via MS Excel VBA code, then retrieve it. But no matter how I enter and format the date, all I get back from MS Access is gibberish.
Cannot figure this one out. Everything I've found online has missed the point in providing a simple explanation as to what the problem is. I did realize that there is a total disconnect between the two applications and I am by far not the only dismayed person.
I think it's fair to expect get out get the same data that you put in. I mean, really, why is this even remotely difficult to do?
The code provided is completely stripped down to the elements required to get at the heart of it all.
Any help would be greatly appreciated.
Robert.
Option Explicit
Public Conn As New ADODB.connection
Public rs As New ADODB.Recordset
Public sconnect As String
Public Const DATABASE_LOC As String = "C:\Users\Robert\Documents\ASAP\db1"
Public Const DATABASE_NAME As String = "Database1.accdb"
'MS Access datatable "TheDate" is a ShortDate
'My system date format is 'standard U.S. - mm/dd/yyyy
'The cell from which result is read is in Date format
'
'Tried:
'ADate = CDate("12/29/2022")
'ADate = #12/29/2022#
'ADate = 'Format("12/29/2022", "mm/dd/yy")
'
'ALL result in: Result IN: ? Date IN: 12/29/2022 - Access table field: 12:00:18 AM
'Result Out: ? Date OUT: 12:00:18 AM - Cell "B1" (Date format) cell value: 1/0/1900 12:00:18 AM
Sub TestDateInAndOut()
TestDateIntoDB
TestDateOutOfDB
End Sub
Sub TestDateIntoDB()
Dim SQLString As StringDim ADate As Date
'option 1
ADate = CDate("12/29/2022")
'option 2
ADate = #12/29/2022#
'option 3
ADate = Format("12/29/2022", "mm/dd/yy")
SQLString = "INSERT INTO Table1 (TheDate) Values(" & ADate & ")" '
OpenSQLConnection ' open connectionrs.Open SQLString, Conn ' &
recordsetCloseSQLConnections
Debug.Print "Date IN: " & CStr(ADate)
End Sub
Sub TestDateOutOfDB()
Dim sSQLSting As String
OpenSQLConnection
sSQLSting = "SELECT * From [Table1]" ' get all data from Table1
rs.Open sSQLSting, Conn
'write the table to worksheetWorksheets("Sheet1").Range("A1").CopyFromRecordset rs
'this will have the record just added to DB (first & only record)
Debug.Print "Date OUT: " & Worksheets("Sheet1").Range("B1")
CloseSQLConnections
End Sub
'Open Access DB connection
Sub OpenSQLConnection()
sconnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DATABASE_LOC & DATABASE_NAME & ";Persist Security Info=False;"
Conn.Open sconnect
End Sub
'Close any DB Connection
Sub CloseSQLConnections()
On Error Resume Next
rs.CloseSet rs = Nothing
Conn.Close
Set Conn = Nothing
End Sub
Consider the best practice of SQL parameterization which is supported with ADO library. This approach which is not limited to VBA or MS Access but any programming language connecting to any backend database allows for binding of values to a prepared SQL query to safely bind literal values and properly align data types:
...
Public cmd As ADODB.Command ' AVOID DECLARING OBJECT WITH New
...
Sub TestDateIntoDB()
Dim SQLString As String
Dim ADate As Date
Const adDate = 7, adParamInput = 1
'option 1
ADate = CDate("12/29/2022")
' PREPARED STATEMENT WITH QMARK PLACEHOLDER
SQLString = "INSERT INTO Table1 (TheDate) Values(?)"
' CONFIGURE ADO COMMAND
Set cmd = New ADODB.Command
With cmd
.ActiveConnection = Conn
.CommandText = SQLString
.CommandType = adCmdText
' BIND VALUES
.Parameters.Append .CreateParameter("paramDate", adDate, adParamInput, , ADate)
End With
' EXECUTE ACTION QUERY
cmd.Execute
Set cmd = Nothing
Debug.Print "Date IN: " & CStr(ADate)
End Sub
Force a format of the string expression for the date value:
Sub TestDateIntoDB()
Dim SQLString As String
Dim ADate As Date
' Option 0.
ADate = DateSerial(2022, 12, 29)
SQLString = _
"INSERT INTO Table1 (TheDate) " & _
"VALUES (#" & Format(ADate, "yyyy\/mm\/dd") & "#)"
' <snip>
End Sub

Square brackets inside the name of column in VBA query?

I have an issue with square brackets inside the name of column I am trying to access.
name of column: [KPI] Standard Delivery Capability SO [<0/0]
this is my code:
Dim rs As New ADODB.Recordset
Dim query As String
Dim WhatToSelect as String
query = "Select " & WhatToSelect & " From" & sourceSheet & ".[Sheet1$]"
rs.Open query, connection
rs.MoveFirst
i = rs.Fields(rs.Fields(0).name).Value
basicly I am trying to find variable, which would be in "WhatToSelect" variable
I have tried:
WhatToSelect = "avg([[KPI] Standard Delivery Capability SO [<0/0]])"
WhatToSelect = "avg(`[KPI] Standard Delivery Capability SO [<0/0]`)"
nothing has worked so far. (it works with every other column, with no [ ] in)
Coudn't find any documentation about that, so I did some experiments. I created a small table containing one column with exact your column name, executed a Select * from [Sheet1$] and had a look to the column name within the returned recordset. Turned out that the brackets where replaced by parenthesis:
Dim conn As ADODB.Connection, rs As ADODB.Recordset
Set conn = New ADODB.Connection
Dim connString As String
connString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Name & ";" & "Extended Properties=""Excel 12.0 Xml;HDR=YES;"""
conn.Open connString
Set rs = conn.Execute("Select * from [Sheet1$]")
Dim i As Integer
For i = 0 To rs.Fields.Count
Debug.Print rs.Fields(i).Name
Next
>> (KPI) Standard Delivery Capability SO (<0/0)
To query this field, you need to (a) enclose the field name with brackets and (b) replace the brackets within the field name with parenthesis:
dim fieldname as String, sql as String
fieldName = "[(KPI) Standard Delivery Capability SO (<0/0)]"
' Use field in result set:
sql = "Select " & fieldname & " from [Sheet1$]"
Set rs = conn.Execute(sql)
' Use field in Where-Clause:
sql = "Select * from [Sheet1$] where " & fieldname & " > 100"
Set rs = conn.Execute(sql)
In your case, where you want to execute a aggregate function on that field, you need to specify
WhatToSelect = "avg([(KPI) Standard Delivery Capability SO (<0/0)])"

How to match Access and Excel records and update Access database?

I have a column with vendor name in an Access table which updates every day (from blank to name) with respect to delivery number (unique).
Every day I want to extract the data from SAP and update the records whose vendor name got updated in System.
I need a SQL query which will match the delivery numbers in Access and Excel workbook and according from Excel work it will capture name of vendor and update Access database.
I have written code that can update only one name at a time, but I want to update everything in one go.
Sub Update()
Sheets("Carrier Updated").Select
'Initialize all variables
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim stDB As String, stSQL As String, stProvider As String
Dim X As Variant
X = Range("A2").Value
Dim Y As Variant
Y = Range("B2").Value
stDB = "C:\Users\yemdema\OneDrive - Ecolab\Desktop\Drive - A\Delivery Creation\DB Backup\Test_1.accdb"
stProvider = "Microsoft.ACE.OLEDB.12.0"
'Opening connection to database
With cn
.ConnectionString = stDB
.Provider = stProvider
.Open
End With
'SQL Statement of what I want from the database
stSQL = "UPDATE Delivery_Creation set [Carrier Updated Later] = '" & Y & "' where[Delivery] = '" & X & "'"
Set rs = cn.Execute(stSQL)
MsgBox ("Carrier has been updated")
'Looping through the records I pulled and inserting the data into the comboBox
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
End Sub
As you probably have different values for X and Y for each pair of values found in the worksheet, you can either update one set (as you do now), or collect these in a (temporary) table and call an update query using that table. No big difference, though.
Or you could "reverse" the process, using Access to link the range in the worksheet as a linked table, and then run an update query using that table.

recordset data is not populated in txt field

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.

Display multiple records using multiple textboxes using select statement

I am trying to retrieve records saved in MS Access database and populate the textboxes with the query result during FORM_LOAD(). So far I retrieve one record. But the problem is, when I try adding the same codes, it is retrieving the first saved record.
It is disregarding the where clause in my sql statement. Here's what I wanted my output to be. During form_load(), I want to display multiple records (activity description/activity_desc) in multiple textboxes on my form. If there is no record in my database, I just want it to be blank.
Here's what i want to achive..
Here's my code snippet:
Private Sub Form_Load()
FrmSchedule.lblnamesched.Caption = FrmInfosheet.Txtname.Text
FrmSchedule.Label36.Caption = FrmInfosheet.cmbsalesgroup.Text
FrmSchedule.lblpositionsched = FrmInfosheet.Txtposition.Text
FrmSchedule.Thisweekdate.Caption = FrmInfosheet.Text3.Text
FrmSchedule.Thisweekdate2.Caption = FrmInfosheet.Text4.Text
FrmSchedule.Label37.Caption = FrmWeek1WAR.Label1.Caption
FrmSchedule.Label38.Caption = FrmWeek1WAR.Label2.Caption
FrmSchedule.Label39.Caption = FrmWeek1WAR.Label21.Caption
FrmSchedule.Label40.Caption = FrmWeek1WAR.Label22.Caption
FrmSchedule.Label41.Caption = FrmWeek1WAR.Label23.Caption
FrmSchedule.Label42.Caption = FrmWeek1WAR.Label37.Caption
FrmSchedule.Label43.Caption = FrmWeek1WAR.Label26.Caption
FrmSchedule.Label44.Caption = FrmWeek1WAR.Label27.Caption
FrmSchedule.Label45.Caption = FrmWeek1WAR.Label28.Caption
FrmSchedule.Label46.Caption = FrmWeek1WAR.Label29.Caption
FrmSchedule.Label47.Caption = FrmWeek1WAR.Label30.Caption
FrmSchedule.Label48.Caption = FrmWeek1WAR.Label38.Caption
Dim conConnection As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sqlStr As String
Dim clone_rs As ADODB.Recordset
Set conConnection = New ADODB.Connection
Set rs = New ADODB.Recordset
With conConnection
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
App.Path & "\" & "WAP.mdb;Mode=Read|Write"
.Open
End With
With rs
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockBatchOptimistic
.ActiveConnection = conConnection
.Open "war", conConnection, adOpenForwardOnly
End With
'Set clone_rs = rs.Clone
With arsProjects
If rs.BOF And rs.EOF Then
.Requery
.MoveFirst
.MoveLast
Else
sqlStr = "SELECT activity_desc FROM war WHERE time = '8' and activity_date = '" & Label37.Caption & "' and sales_group = 'ALC Holdings CO., INC' and day = 'Monday'"
Text1.Text = rs.Fields("activity_desc")
sqlStr = "SELECT activity_desc FROM war WHERE time = '9' and activity_date = '" & Label38.Caption & "' and sales_group = 'ALC Holdings CO., INC' and day = 'Tuesday'"
Text2.Text = rs.Fields("activity_desc")
End If
End With
Set rs = Nothing
Set conConnection = Nothing
End Sub
If I'm doing it wrong, what would be the proper function or code for me to achieve what I wanted. Any help and suggestions would be much appreciated. By The way, I am trying to use multiple select query to achieve this.
Your assigning the SELECT statement to sqlStr but it doesn't look like your using sqlStr anywhere. In rs.Open you have a select statement of "war" and not sqlStr.