VBA ADO query on Excel workbook - vba

I have the following code to retrieve data from another workbook. However I want the SQL code take into account a where clause. This where clause should be applied on one of the columns. Up till now my code works but not after adding the where clause. The column header is Cost_center. What should I write differently in my code to let the code only get data where the Cost_center column is like a certain number?
Sub newbie2() Set cn = CreateObject("ADODB.Connection") Set rs = CreateObject("ADODB.Recordset")
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\INP_DEPARTMENT_SOL_DEL.xlsx" & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
cn.Open strCon
strSQL = "SELECT * from [sheet1$] WHERE [COST_CENTER] LIKE 5560"
rs.Open strSQL, cn, 0, 1 'cursortype = adOpenForwardOnly, locktype = adOpenReadonly
ThisWorkbook.Worksheets("Sheet2").Range("A:A").CopyFromRecordset rs
rs.Close
cn.Close
Set rs = Nothing
Set con = Nothing
End Sub
Thanks in advance,
Michiel

I'm guessing you are not getting cost centers that contain "5560" but would get cost centers that are exactly "5560."
The problem is in this line:
strSQL = "SELECT * from [sheet1$] WHERE [COST_CENTER] LIKE 5560"
The LIKE statement requires wildcard characters. For ADO, the wildcard character is %
Change the code to:
strSQL = "SELECT * from [sheet1$] WHERE [COST_CENTER] LIKE '%5560%'"
and it should work as desired.

Related

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)])"

Issue with ODBC Object connection - Open limitation to 65k rows

New to programming, SQL and VBA. I frequently work with decent size data tables and thought it would be helpful to add SQL query execution capability to apply to an existing excel table. Research led me to ADODB connections and found a great base snippet to work from here: https://blog.learningtree.com/excel-as-a-database-how-to-query-economic-data-with-sql/
I seem to running into limits though on how many rows are accessible before the next line of code runs. In my SQL statement source I can return 65k rows, any more in defining the source table size, and I get an Object does not exist error. Can you run ADODB recordset.Open asynchronously to ensure complete return of the object? - Any help would be very much appreciated.
Thanks!
tried to insert a WAIT inline:
rs.Open strSQL, Application.Wait (Now + TimeValue("0:00:30")), cn
but still errors out. See code below
Sub ExcelTbl_SQL()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
strFile = ThisWorkbook.FullName
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
strSQL = "SELECT * FROM [Sheet1$A1:AI146103] WHERE GROUP = 'HIX'"
rs.Open strSQL, cn
Dim ws As Worksheet
Set ws = Application.Sheets.Add
ws.Range("A1").CopyFromRecordset rs
rs.Close
cn.Close
'Debug.Print rs.GetString
End Sub
These are the results I am getting:
Works: strSQL = "SELECT * FROM [Sheet1$A1:AI65000] WHERE GROUP = 'HIX'"
Error: strSQL = "SELECT * FROM [Sheet1$A1:AI65437] WHERE GROUP = 'HIX'"
Run-time error '-2147217865 (80040e37)': The Microsoft Access database
engine could not find the object 'Sheet1$A1:AI65437'.
I think this is because you are calling old version library through this part of connection string:
Provider=Microsoft.ACE.OLEDB.12.0
You should try
Provider=Microsoft.ACE.OLEDB.16.0
Upd: Answer was here Excel as database - query more than 65536 rows? interesting. You cannot mention rows, or you'll get error.

ADODB recordset recordcount always returns -1

I am trying to retrieve data to excel form a database in MS access. However the recordcount property for recordset always return -1 though for other purposes the code is working fine.
The code I am using is as follows :
`Sub datarecordset()
Dim cn As adodb.Connection
Dim oRs As adodb.Recordset
Set cn = CreateObject("ADODB.Connection")
DBPath = "C:\[databse path]" & "\[database name].accdb"
dbWs = "[excel sheet name]"
scn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBPath
dsh = "[" & "[excel sheet name]" & "$]"
cn.Open scn
Dim sSQL As String
Dim F As Integer
sSQL = "Select 'W',a.[Subledger],NULL,sum(a.[Amount]) from GL_Table a where a.[Opex_Group] = 10003 and year(a.[G/L Date]) = " & Year(Sheets("Repairs").Cells(1, 4)) & " and month(a.[G/L Date]) = " & Month(Sheets("Repairs").Cells(1, 4))
sSQL = sSQL & " group by " & "a.[Subledger],(year(a.[G/L Date])),(month(a.[G/L Date]))"
Set oRs = cn.Execute(sSQL)
Debug.Print oRs.RecordCount
oRs.Close
....... further code to print to excel here
cn.Close
End Sub`
The code will fetch data in recordset and write in excel. But since the recordset property is not returning the recordcount so can't print values of various fields in recordset to different cells of excel worksheet.
I searched on google and understood that I need to declare the recordset type and for that I have to use connection.open in place of connection.execute. But I am trying to change the code then it gives the error object variable or With variable not defined.
Any quick help will be welcome. Thanks.
The link by #BitAccesser provides a valid solution. Quick how-to-implement in your situation:
Instead of Set oRs = cn.Execute(sSQL)
Set oRS = CreateObject("ADODB.Recordset")
oRS.CursorLocation = adUseClient
oRS.Open sSQL, cn
ADO's recordcount property returns -1 when ADO cannot determine the number of records or if the provider or cursor type does not support RecordCount. That last one is true for this case.
To avoid this, there are several solutions. The most simple one is to use a client-side cursor, which I just demonstrated, but more alternative solutions are provided in the links by #BitAccesser
You may also specify the CursorType as the third argument to open the RecordSet as follows, which is optional
The first two lines, leaving blank or selecting adOpenDynamic, do not give the record count.
The remaining ones work OK.
1-RS.Open SqlStr, Conn
2-RS.Open SqlStr, Conn, adOpenDynamic
(Erik's solution)
- 3-RS.CursorLocation = adUseClient
Other Options also work fine, please note 4- and 6- which do not require a seperate line
- 4-RS.Open SqlStr, Conn, adOpenKeyset
- 5-RS.Open SqlStr, Conn, adOpenKeyset AND RS.CursorLocation = adUseClient
- 6-RS.Open SqlStr, Conn, adOpenStatic AND RS.CursorLocation = adUseClient
- 7-RS.Open SqlStr, Conn, adOpenStatic
BR, Çağlar
You can still use the Execute method but you need to set the correct cursor type. The recordset is created automatically with cursor type adOpenForwardOnly. This results in oRs.RecordCount = -1. adOpenKeySet is the correct cursor type to correctly show oRs.RecordCount.
Note: The LockType is irrelevant in this case.
Set oRs = cn.Execute(sSQL)
oRs.Close
oRs.CursorType = adOpenKeyset
oRs.Open
Debug.Print oRs.RecordCount
Closing the recordset, changing the cursor type and reopening the recordset worked fine for me (Access 2016 on Windows 7).

insert full ADO Recordset into existing ACCESS table WITHOUT LOOP

I have a filled ADO recordset in my VBA module. I also have a table in ACCESS that has exactly the same structure as the recordset.
Now I fill the table using a loop (which is fine) going through each dataset record.
What I am wondering: is there a way to insert an entire recordset into the access table? (and more importantly: would this be significantly faster)
Here's a basic example (run from excel in this case) which illustrates using a disconnected recordset to add records.
Sub Tester()
Dim con As ADODB.Connection, rs As ADODB.Recordset
Dim i As Long
Set con = getConn()
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient '<<<< important!
'get an empty recordset to add new records to
rs.Open "select * from Table1 where false", con, _
adOpenDynamic, adLockBatchOptimistic
'disconnect the recordset and close the connection
Set rs.ActiveConnection = Nothing
con.Close
Set con = Nothing
'add some new records to our test recordset
For i = 1 To 100
rs.AddNew
rs("UserName") = "Newuser_" & i
Next i
'reconnect to update
Set con = getConn()
Set rs.ActiveConnection = con
rs.UpdateBatch '<<< transfer to DB happens here: no loop!
rs.Close
'requery to demonstrate insert was successful
rs.Open "select * from Table1", con, _
adOpenDynamic, adLockBatchOptimistic
Do While Not rs.EOF
Debug.Print rs("ID").Value, rs("UserName").Value
rs.MoveNext
Loop
rs.Close
con.Close
End Sub
Function getConn() As ADODB.Connection
Dim rv As New ADODB.Connection
Dim strConn As String
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source = " & ThisWorkbook.Path & "\Test.accdb"
rv.Open strConn
Set getConn = rv
End Function
VBA Recordsets exist virtually in memory called during runtime until they are contained into an actual physical format (i.e., csv, txt, xlsx, xml, database temp table) saved to hard disk. This is akin to data frames in R or Python pandas, SAS datasets, PHP arrays, and other data structures.
Consider exporting your ADO in such a format using CopyFromRecordset methods into an Excel spreadsheet to be saved as csv, txt, xlsx, or xml. Alternatively, you can use the Save method to save recordset in a persistent format type like xml.
Then, append resultant file to MS Access table with its automated data migration features:
For spreadsheets: DoCmd.TransferSpreadsheet
For txt, csv, or other delimited files: DoCmd.TransferText
For xml files: Application.ImportXML
For local or ODBC/OLEDB linked database tables: INSERT INTO append SQL query
To accomplish this with a SQL statement you use the SELECT/INSERT... IN [Designate DB A; record posted to] or FROM... IN [Designate DB B; record original source]
You can only use the IN statement once in a single query. Therefore you create the other connection using the ADODB connection to determine the other source connection.
Function example()
Dim dB_External As String
Dim db_Local As String
Dim cnLocal As ADODB.Connection
Dim cnExternal As ADODB.Connection
Set cnLocal = CurrentProject.Connection
Set cnExternal = New ADODB.Connection
cnExternal .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\\...accdb;Persist Security Info=False;"
dB_External = "C:\Users\\...accdb"
db_LOCAL = "C:\Users\\...accdb"
Example A:
strSQL = "INSERT INTO *Local table to receive records* (Column Designations)"
strSQL = strSQL & " SELECT ( *Corresponding records from external table* )"
strSQL = strSQL & " FROM *External table name* IN '" & dB_External & "'"
cnLocal.Execute (strSQL)
I use the above code, with the local ADODB connections if I select from a single external table.
Example B:
strSQL = "INSERT INTO *Local table to receive records* (Column Designations) IN '" & dblocal & "'"
strSQL = strSQL & " ( *Corresponding records from external table* )"
strSQL = strSQL & " FROM *External table name*
cnExternal.Execute (strSQL)
I use the above code using the external ADODB connection, if I select involves joining multiple tables in the external db.
No. There is no reverse equivalent - could be SetRows - to the method GetRows.

MS Access 2007, checking current user against a table

We have a simple access database, and would like a button on a form to only be available to select members of staff. (The button has an event tied to it). I'd like to store the usernames of the staff allowed to click the button in a separate table.
What I'd like to do, is perform a simple query to see if the username exists in the table, and set the enabled state of the button depending upon the outcome.
My background is C# and SQL Server, but VBA and access are new to me, and I think I'm struggling with the quirks of this environment.
I've got the username of the logged on user in a string fOSUserName via a call to GetUserNameA in advapi32.dll, but I'm struggling with the simplest of queries to determine if the username exists in the table.
Dim strSQL As String
Dim intResult As Integer
Dim db As DAO.Database
Dim rs As Recordset
Set db = CurrentDb
strSQL = "SELECT COUNT(*) FROM [USERS] WHERE [USERS].[NAME] = '" & _
fOSUsername & "'"
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
If Not rs.EOF Then
intResult = rs.Fields(0)
Else
intResult = 0
End If
rs.Close
db.Close
This fails on db.OpenRecordset giving me the error
Run-time error '3061':
Too few parameters. Expected 1.
Can anyone offer some pointers?
When you continue a line in VBA, you need a space between before the line continuation character ("_"). So instead of this:
strSQL = "SELECT COUNT(*) FROM [USERS] WHERE [USERS].[NAME] = '" &_
fOSUsername & "'"
Use this:
strSQL = "SELECT COUNT(*) FROM [USERS] WHERE [USERS].[NAME] = '" & _
fOSUsername & "'"
However, as #Igor Turman pointed out, the lack of a space before the underline character should trigger a compile error. So I'm unsure what's going on but suggest you fix it anyway to avoid confusion.
I'll suggest that rather than opening a recordset, and then reading a value from that recordset, this could be handled simply with the DCount() function.
Dim strCriteria As String
strCriteria = "[USERS].[NAME] = '" & fOSUsername & "'"
Debug.Print "strCriteria: '" & strCriteria & "'"
If DCount("*", "USERS", strCriteria) = 0 Then
Debug.Print "not found"
Else
Debug.Print "found"
End IF
If your missing parameter error is because USERS is a query rather than a table, you can ask DCount() to use a table instead. Or fix the query.
Sounds like your [USERS] object is not a table but Query (with parameter). Also, if you had a syntax error like '&_'(invalid) as opposed to '& _'(valid), your database would not compile. So, if table vs query is your case, please use the following:
...
Dim rs As Recordset
Dim qdf As QueryDef
Set qdf = CurrentDb.QueryDefs("Users")
qdf.Parameters("UserNameParameter") = fOSUsername
Set rs = qdf.OpenRecordset
...
I'm not totally familiar with the way you are using it, but I've always done it this way:
Dim sSQL As String
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=[your access db file path and name];Persist Security Info=False"
sSQL = "SELECT COUNT(*) FROM [USERS] WHERE [USERS].[NAME] = '" &_
fOSUsername & "'"
Set rs = New ADODB.Recordset
rs.Open sSQL, cn
If Not rs.EOF Then
intResult = rs.Fields(0)
Else
intResult = 0
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing