First time poster, I finally had a question that I couldn't find an answer to here.
I have an MS Access query that returns 1 result (which is a number) that I want to store as an integer variable (x) so I can use it later for a loop. The issue is that because I'm using it as a recordset and the variable is an integer, I'm receiving a "Type Mismatch" error.
Right now I'm just storing the result to a cell and setting the variable equal to the cell:
Ws.Range("A1") = Db.OpenRecordset("SELECT COUNT(Asset_Name) FROM Assets WHERE Active = True").GetRows(1)
x = Ws.Range("A1")
Ws.Range("A1").Delete
And then later I just have a loop that runs x times:
For i = 0 To x
Basically, I just want to have some code that looks like this:
x = Db.OpenRecordset("SELECT COUNT(Asset_Name) FROM Assets WHERE Active = True").GetRows(1)
Any help here would be huge. Thank you!
The following should give you the correct result:
Dim x As Integer
Dim db As DAO.Recordset
db.MoveFirst
If IsNumeric(db.OpenRecordset("SELECT COUNT(Asset_Name) FROM Assets WHERE Active = True").Fields(0).Value) Then
x = CInt(db.OpenRecordset("SELECT COUNT(Asset_Name) FROM Assets WHERE Active = True").Fields(0).Value)
Else
MsgBox "The query did not return a number." & Chr(10) & "Aborting..."
End If
Note, that you are using DAO and not ADO as your original tags on the post indicated. Still, they both behave rather similar and the cursor is normally on the first row (when the data is returned). So, MoveFirst should not be necessary. Still, Microsoft themselves keep using it in its own sample code all the time. The first column if for DAO and ADO alike .Fields(0).
Related
I am trying to understand what I have done wrong in the code snippet below. I am reading some session records with a specific Client ID and putting the records returned into LineGrid for further processing. The problem is with the line NoL = Rs.RecordCount The query returns multiple lines (I can see this in the development environment). So in one example NoL is assigned the value 1 even although Rs.Recordcount is larger (3). I can check this directly in the debug environment.
At risk of stating the obvious even is record count is 3 only the one row is inserted into LineGrid
Dim Db As DAO.Database
Dim RsCL As DAO.Recordset 'ClientSession
Dim NoL As Integer
Dim LineGrid As Variant
Set RsCL = Db.OpenRecordset("Select * From ClientSession WHERE ClientID = " & CDID)
If RsCL.EOF Then
MsgBox ("Nothing to Invoice")
Exit Sub
End If
'RsCL.MoveFirst
NoL = RsCL.RecordCount
LineGrid = RsCL.GetRows(NoL)
RsCL.Close
I have tried
Changing the data type of NoL to Long - No effect
Putting Rs.Count in the place of (NoL) in GetRows property - No effect
If I replace NoL with a value e.g. 100 then the code works fine then all records are loaded into LineGrid but I don't have the true record count.
I have tried moving the record pointer with .movefirst property ( you will note that line is currently commented out) - No effect
Ultimately I need LineGrid to contain the data from the table and NoL to have the true record count
When you open a recordset, not all of the records are loaded immediately. In order to force all of the records to load, you need to move to the last record before moving back to the first one:
RsCL.MoveLast
RsCL.MoveFirst
Regards,
I have a power query function, e.g. getData with one parameter filename
Can I invoke that function directly in a vba variable? Something like:
Sub MyTest()
Dim MyVar
MyVar = ThisWorkbook.Queries("getData").Invoke("mytable.xls")
MsgBox "The Value is " & MyVar
End Sub
I use Excel 2016
Unfortunately, you cannot load the Power Query result to a VBA variable. You have to first load it to the sheet.
Here is a thread, where a Microsoft employee confirms that:
Link to Microsoft Employee relating to that issue
Contrary to the link in the accepted answer, it is possible to get an array from a query if you load the query to the data model. It can be a pain, and there are lots of pitfalls (spaces in table names, and I haven't tested where the query output is a list or otherwise not a table).
These functions aren't cleaned up, but they have given me success, and show where to poke around.
Function GetModelADOConnection()
'We just need the ADOConnection; the rest is for perusal
Set wbConnections = ThisWorkbook.Connections
Set Model = ThisWorkbook.Model
Set ModelDMC = Model.DataModelConnection
Set ModelDMCMC = ModelDMC.ModelConnection
Set GetModelADOConnection = ModelDMCMC.ADOConnection
End Function
Sub ListConnectionTables()
'Run this to dump a list of available tables in the immediate window, so you can see what you'll need to query
'https://learn.microsoft.com/en-us/office/client-developer/access/desktop-database-reference/schemaenum
Set conn = GetModelADOConnection
Set TablesSchema = conn.OpenSchema(20)
Debug.Print "TABLE_SCHEMA", "TABLE_NAME", "COLUMN_NAME" 'headers for immediate window
Do While Not TablesSchema.EOF
Set ColumnsSchema = conn.OpenSchema(4, Array(Empty, Empty, "" & TablesSchema!TABLE_NAME))
Do While Not ColumnsSchema.EOF
If TablesSchema!TABLE_SCHEMA <> "$SYSTEM" Then
Debug.Print TablesSchema!TABLE_SCHEMA, TablesSchema!TABLE_NAME, ColumnsSchema!COLUMN_NAME
End If
ColumnsSchema.MoveNext
Loop
TablesSchema.MoveNext
Loop
End Sub
Function GetRecordSetFromConnection(TABLE_NAME)
'Requires that connection is added to data model.
'Watch out for table names with spaces in them - would need additional handling
'Use the ListConnectionTables function provided above to try to sniff out what to use for the TABLE_NAME, and additional trial and error may be needed
Set conn = GetModelADOConnection
Set rs = CreateObject("ADODB.RecordSet")
rs.Open "SELECT * From $" & TABLE_NAME & ".$" & TABLE_NAME, conn
Set GetRecordSetFromConnection = rs
End Function
If you succeed in getting your query into a recordset, then hopefully you know where to go from there. The simplest way to turn that into an array is with myRecordSet.GetRows(). That gives a transposed version of the table, but for help from there it will just require some Googling.
I hope this is a simple question and you don't have to waste too much of you time on it.
I have an report (called repRAD78) which contains a textbox (called txtRAD8). I would like to populate txtRAD8 with a calculated value based on numbers pulled from a query called qryrRAD78.
Looking through the forums it looks like recordsets would be the solution but this is my first foray into recordsets and it's not going well. :(
The code I have pasted in below I have pulled together from a number of places and it doesn't produce any errors but puts the same value into txtRAD8 for all the records.
I'm sorry if this is a stupid question but it's been driving me potty.
Many thanks for your time.
Al.
Public Sub Calc()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("qryrRAD78")
rst.MoveFirst
Do Until rst.EOF = True
Dim lngMean As Long
Dim lngRAD78max As Long
Dim lngRAD78_1 As Long
Dim lngRAD78_2 As Long
Dim lngRAD78_3 As Long
Dim lngRAD7 As Long
Dim lngRAD8 As Long
lngRAD78_1 = rst![RAD78_1]
lngRAD78_2 = rst![RAD78_2]
lngRAD78_3 = rst![RAD78_3]
lngRAD8b_c = rst![RAD8b_c]
lngMean = (lngRAD78_1 + lngRAD78_2 + lngRAD78_3) / 3
lngRAD78max = Maximum(Abs(lngRAD78_1), Abs(lngRAD78_2), Abs(lngRAD78_3))
lngRAD7 = ((lngRAD78max - lngMean) / lngMean) * 100
lngRAD8 = ((lngMean - lngRAD8b_c) / lngRAD8b_c) * 100
txtRAD8.Value = lngRAD8
rst.MoveNext
Loop
rst.Close
dbs.Close
End Sub
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
Calc
End Sub
Here's a second approach to this. Rather than using a function in the code, take the calculations from your Calc() routine and put them in another query.
SELECT idrRAD78,
(RAD78_1 + RAD78_2 + RAD78_3) AS Mean,
(IIf(Abs(RAD78_1) > Abs(RAD78_2),
IIf(Abs(RAD78_1) > Abs(RAD78_3), RAD78_1, RAD78_3),
IIf(Abs(RAD78_2) > Abs(RAD78_3), RAD78_2, RAD78_3))) AS RAD78Max,
(((RAD78max - Mean) / Mean) * 100) AS RAD7,
(((Mean - RAD8b_c) / RAD8b_c) * 100) AS RAD8
FROM qryrRAD78
This will give you a query that performs the same calculations as your existing function. Then just edit the report query to join to this new query (just like joining a table) using something like:
FROM ReportQuery INNER JOIN NewQuery ON ReportQuery.idrRAD78 = NewQuery.idrRAD78
Change the query names to match the real names. Add the fields from the new query in the SELECT part of your report query:
SELECT <existing field list>, RAD7, RAD8
Then set txtRAD8 to the RAD8 field.
I'm just doing this from memory as I'm not in front of my own computer, but hopefully that makes sense and is close enough to the correct code.
The problem with this function is that every row on the report is going to have a textbox called txtRAD8. So what you are really doing is updating every textbox on the report with the same value (once for every loop through the recordset). You are not actually setting the value for each individual row.
What you need to do is make the value of the textbox = Calc(RowID). Then your query uses the passed-in parameter to get the value for that one record instead of looping through the whole recordset, and updates just that one row on the report.
So your Sub becomes a Function, and returns the calculated value.
I have the following code in my Excel VBA that copies data from a table in SQL into Excel. This data is being inserted horizontally starting on cell C2, but I want it to be inserted vertically on column C.
Sheets("Control").Range("C2").CopyFromRecorset rsPubs
Where rsPubs is my ADO connection.
Basically, I just want this data transposed. What's an efficient way of doing this?
This is how rsPubs is created (the connection works fine as I'm actually getting the data):
' Create a recordset object.
Dim rsPubs As ADODB.Recordset
Set rsPubs = New ADODB.Recordset
With rsPubs
' Assign the Connection object.
.ActiveConnection = cnPubs
' Extract the required records.
.Open "SELECT * FROM Analytics.dbo.XBodoffFinalAllocation"
' Copy the records into cell B3 on Sheet1.
Sheets("Control").Range("C2").CopyFromRecordset rsPubs
' Tidy up
.Close
End With
cnPubs.Close
Set rsPubs = Nothing
Set cnPubs = Nothing
I cannot test this currently, but you could:
Sheets("Control").Range("C2").CopyFromRecorset rsPubs 'copy your data
Sheets("Control").Range("C2").Copy 'copy the data into clipboard
Sheets("Control").Range("C2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, True, True
Also you could use the Transpose Worksheetfunction - however, I don't quite see a way right now to do this directly, expect your input data is transposed already.
Here is a nice official example and further informations on this topic: How to transfer data from an ADO Recordset to Excel with automation
Especially the "using GetRows" section.
This should do:
Dim resultset As Variant
Dim result As Variant
resultset = rsPubs.GetRows
result = Application.WorksheetFunction.Transpose(resultset)
Sheets("Control").Range("C2").Resize(UBound(result, 1), UBound(result, 2)) = result
http://www.teachexcel.com/excel-help/excel-how-to.php?i=147811
Edit 2 in the accepted answer doesn't work for me, but the following does (see http://www.mrexcel.com/forum/excel-questions/513845-copyfromrecordset-transpose.html for my source):
Public Sub PlaceTransposedResults(oResults As ADODB.Recordset, rTarget As Range)
Dim vTransposed As Variant
If Not oResults.EOF Then
vTransposed = oResults.GetRows
rTarget.Resize(UBound(vTransposed, 1) + 1, UBound(vTransposed, 2) + 1) = vTransposed
End If
End Sub
(this assummes that you haven't changed the array base with the OPTION BASE and that your version of Excel has Range.Resize and that oResults is never nothing)
One tweak on this is to make this a function and return the correctly sized range - useful if you want to resize a named range to cover the result set.
Another likely tweak is that you may want to optionally allow the user to ask for the field names to be added as the in the first column. I have found nothing better than:
Dim ix As Integer
For ix = 0 To oResults.Fields.Count - 1
rTarget.Offset(ix, 0) = oResults.Fields(ix).Name
Next ix
(of course you then have to offset your main results by 1 column in this case).
Untested:
Sub CopyTransposed(rng As Range, rs As ADODB.Recordset)
Dim x As Long, y As Long
x = 0
Do While Not rs.EOF
For y = 0 To rs.Fields.Count - 1
rng.Offset(y, x).Value = rs.Fields(y).Value
Next y
x = x + 1
rs.MoveNext
Loop
End Sub
This is really simple. It uses Excel's built-in transpose. Can be transposed in a single statement. No looping is needed. Tested and validated.
Dim vRecs, vRecsX
vRecs = rsPubs.GetRows
vRecsX = Application.Transpose(vRecs)
Sheets("Control").Range("C2").Resize(rsPubs.RecordCount, rsPubs.Fields.Count) = vRecsX
This code is copied directly from a working example.
Note, since this is a worksheet function, expect it to work with arrays of size only up to the number of columns on a worksheet. I believe columns-per-sheet varies between different versions of Excel, so it's a safe bet to determine your transpose limit based on your version of Excel.
"In the modern versions of Excel this is column XFD, which is 16,384 columns. In older versions of Excel (2003 and prior) the last column was IV which is 256 columns."
https://officemastery.com/_how-many-rows-and-columns-in-excel/
My suggestion is not to use VBA, at all. Microsoft already provided you the facility to import data from a database.
Data -> Import External Data
It will, then, create a QueryTable inside the sheet where you can just right-click and refresh in a regular basis. Another bonus is that you don't get the nasty macro warning. The QueryTable can be a table, query or stored procedure.
Try it!
I want to iterate over all rows of a MS-Word mail merge data source and extract the relevant data into an XML.
I'm currently using this code:
Imports Microsoft.Office.Interop
Do
objXW.WriteStartElement("Recipient")
Dim objDataFields As Word.MailMergeDataFields = DataSource.DataFields
For Each FieldIndex As Integer In mdictMergeFields.Keys
strValue = objDataFields.Item(FieldIndex).Value
If Not String.IsNullOrEmpty(strValue) Then
strName = mdictMergeFields(FieldIndex)
objXW.WriteElementString(strName, strValue)
End If
Next
objXW.WriteEndElement()
If DataSource.ActiveRecord = LastRecord Then
Exit Do
Else
DataSource.ActiveRecord = Word.WdMailMergeActiveRecord.wdNextDataSourceRecord
End If
Loop
And it turns out to be a little sluggish (About 1 second for each row). Is there any way to do it faster?
My fantasy is finding a function like MailMergeDataSource.ToDatatable and then inspecting the datatable.
Any time you're iterating through something row by row, and then doing some kind of processing on each row, is going to get a little slow.
I would be inclined to approach this problem by having a step before this which prepared the mdictMergeFields collection so that it only contained elements that were not 'null or empty', this will mean you won't have to check for that on each iteration. You could do this in process, or 'sneakily' in the background while the user is doing something else.
The other thing to try (might help!) is to change the "Do... Loop" block so that you're not checking at the end of each imported row whether or the record is the 'last record'. Instead, get a count of the records, and then compare the current index to the knowm maximum (which might be quicker)
I.E.:
Dim i, x as Integer
i = ActiveDocument.MailMerge.DataSource.RecordCount
Do While x < i
objXW.WriteStartElement("Recipient")
Dim objDataFields As Word.MailMergeDataFields = DataSource.DataFields
For Each FieldIndex As Integer In mdictMergeFields.Keys
strValue = objDataFields.Item(FieldIndex).Value
If Not String.IsNullOrEmpty(strValue) Then
strName = mdictMergeFields(FieldIndex)
objXW.WriteElementString(strName, strValue)
End If
Next
objXW.WriteEndElement()
x += 1
Loop
I don't really work with the Office Interop much, but hopefully this might offer some assistance! Post back, let me know how it goes.
/Richard.