I have to write some VBA code in excel to go with my VB.NET program and I am struggling with the basics of VBA as I have not used it before. I found some code which allowed me to get the values from my temporary table and put them directly in appropiate fields in the excel spreadsheet. I am populating a purchase order document, so information passed over are things like subtotal, vat, shipping, total, etc.
This is the code I have used to populate a single cell:
'get quantity
strQry = "SELECT quantity from [temp];"
Set rs = New ADODB.Recordset
With rs
Set .ActiveConnection = cn
.Open strQry
End With
'append data to document
Worksheets("PurchaseOrder").Range("D22").CopyFromRecordset rs
quantity = rs.Fields("quantity") 'setting the quatity in a variable
The last line of code is my attempt of storing the value of quantity in a variable, which I need to use to calculate the sub total as sub total was not passed over to excel. The code to populate the cells works fine, it is just putting the data in a variable to manipulate which I am struggling with. Populating the cells directly from the database works fine, but I am getting an error on that last line.
After storing quantity in a variable, I would also like to store the cost per unit in a variable, remove the £ sign at the start using a substring equivalent, convert it to a decimal then times the cost per unit by the quantity to get the sub total.
I tried using this following code:
'get price
strQry = "SELECT costPerUnit from [temp];"
Set rs = New ADODB.Recordset
With rs
Set .ActiveConnection = cn
.Open strQry
End With
'append data to document
Worksheets("PurchaseOrder").Range("N22").CopyFromRecordset rs
costPerUnit = Right(rs(0), Len(costPerUnit) - 1) 'setting the cost per unit in a variable
subtotal = costPerUnit * quantity
Worksheets("PurchaseOrder").Cells("Q47").Value = "£ " & subtotal
Any help is appreciated. Thankyou.
Ok. So until filling the of the Recordset you have done it correct and then you have to see that the Recordset is more like a table and can have none or multiple rows with multiple columns.
First you have to check if the query returned any result or if the Recordset is empty (rs.BOF and rs.EOF are true). Then you would loop through the rows (rs.MoveNext).
To access a single value you can either give the index of the column or the column name.
The following example loops through rows and through columns but also extracts again the column "quantity" at the end:
If (rs.EOF) And (rs.BOF) Then
Exit Function
Else
rs.MoveFirst
Do Until rs.EOF
For j = 1 To rs.Fields.Count
valueOfColumnJ = rs.Fields(j - 1).Value
Next j
quantity = rs.Fields("quantity")
rs.MoveNext
Loop
End If
Recordsets have a cursor and any reference to the recordset is going to return properties (like the value of a field) based on where that cursor is.
When you called CopyFromRecorset, you moved the cursor to the end (EOF = True). Then when you tried to get the Fields("quantity"), there was no active record of the recordset, so you got an error.
You could have first done rs.MoveFirst if you have the right type of recordset. Then quantity would have equaled the quantity field from the first record. Probably not what you want.
There is not a one-liner (as far as I know) that will get you the total of all the fields in your recordset. You have to loop like Graffl shows.
What might be the better path is to use Excel. You already have the data in there, so insert a formula to get the subtotal you want.
Worksheets("PurchaseOrder").Cells("Q47").Formula = _
"=SUMPRODUCT(P23:P46*Q23:A46)"
or something like that.
you can save Recordset to array
as shown below
Sub Check_gg_date_time_Unique(i As Integer)
Dim filmSet As New ADODB.Recordset
Dim dbConn As New ADODB.Connection
Dim filmName As String, lastrow As Integer
Dim Varray As Variant
dbConn.ConnectionString = "Provider=MSDASQL.1;Data Source=Excel_to_MySQL_Maintenance"
dbConn.Open
Set filmSet = dbConn.Execute("select count(wono) from maintennce_db.work_order where post_gg_date_time = '2022-08-30 14:21:37'")
Varray = filmSet.GetRows(1)
If Varray(0, 0) = 0 Then
'Do whatever you want
End If
End Sub
Related
I am trying to retrieve records from Oracle SQL database and write them into a dictionary. Catch is that this code works as expected on my machine but no on my coworker's. On his end Recordset retrieves only one record even if that Recordset has RecordCount higher than one, meanwhile that same query pull up multiple records for me.
Initially I thought that MoveNext method is causing problems but once I switched to GetRows method issue persists. Anyway since this code works on my machine I'm fairly certain that my code correct, but you never know so I am including function in question here. The commented part contains the loop when I was using MoveNext but like I said changing that loop does not help with my problem.
Public Function WriteQueryToDict(SQL As String) As Dictionary
'First column of the query must contain key that will be used to locate records in the dictionary
'Output is a dictionary with first column as key, and the rest in an array that is indexed from 0
Dim Results As Recordset
Dim ResultsArray() As Variant
Dim cursorField As Integer
Dim cursorRow As Integer
Dim Output As Dictionary
Dim key As Variant
Dim record() As Variant
Set Results = RunQuery(SQL)
Set Output = New Dictionary
If Not (Results.BOF And Results.EOF) Then
' New loop
ResultsArray = Results.GetRows()
ReDim record(0 To (UBound(ResultsArray, 1) - 1))
For cursorRow = 0 To UBound(ResultsArray, 2)
key = ResultsArray(0, cursorRow)
For cursorField = 1 To UBound(ResultsArray, 1)
record(cursorField - 1) = ResultsArray(cursorField, cursorRow)
Next
Output.Add key, record
Next
' Original loop
'Results.MoveFirst
'Do
' For cursorField = 1 To Results.fields.Count - 1
' record(cursorField) = Results.fields(cursorField).Value
' Next
'
' key = Results.fields(0)
' Output.Add key, record
' Results.MoveNext
'Loop Until Results.EOF
End If
Set WriteQueryToDict = Output
End Function
In case this might be relevant this is function that does the actual connection + querying:
Private Function RunQuery(SQL As String) As Recordset
Dim Username As String
Dim Password As String
Dim DBConn As ADODB.Connection
Username = ThisWorkbook.Sheets("Configuration").Range("C3").Value
Password = ThisWorkbook.Sheets("Configuration").Range("C4").Value
Set DBConn = New ADODB.Connection
With DBConn
.Provider = "OraOLEDB.Oracle.1;user id = " & Username & "; password = " & Password
.CONNECTIONSTRING = "Data Source=" & DB
.Open
End With
Set RunQuery = DBConn.Execute(SQL)
End Function
I am guessing that this has to do with some setting set outside of my code, my colleague has no knowledge to configure oracle drivers on his own so I am at loss as to what tis might be. Anyway I've never seen my code produce such differences between two different machines so I'm not sure what am I looking for to fix this problem, I will share additional details as needed if you can tell what might be missing here.
Thank you
UPDATE:
When debugigng I setup a breakpoint inside WriteQueryToDict right before the loop starts, that way I was able to Play with Recordset itself first check the RecordCount property to make sure that we have records to iterate over last time I ran this on his machine I saw about 60 records, then call MoveFirst and my epectation is that now I will be able to call MoveNext 60 times before EOF turns true, instead it turn true after first call. while at it I tried setting cursorLocation to Client but that didn't have any effect.
So I have a form that executes a VBA script via a macro. The purpose of said script is to open Excel, create a new workbook, gather information from several tables and export them to a formatted spreadsheet. Each person has a sheet with their name, and the relevant data is printed in said sheet. It works perfectly for the most part. Only one problem... The table in Access where the name and demographics data is gathered from is formatted to sort by last name ascending alphabetically. The VBA script exports it in the order the names were entered. I want my VBA script to respect the formatting in the database table, and I would prefer not to have to add an alphabetizing subroutine to my VBA script.
Table A Format: ID, Active, Last, First, Role, Traveler, Resident, Preceptee, Phone, Completion
Table B Format: ID, Course, Course ID, Offered, HLC, Course Type
Last in Table A called "Roster" is the field with which I want my VBA script to sort alphabetically. The database is already configured to do this.
Thanks in advance!
VBA Code:
Option Compare Database
' This module exports the database to a spreadsheet with specific formatting when called from a Macro
' Each Employee will have a sheet named thier last name which will contain all HLC modules they have completed in a list
' It is specific to this Database, but can be adapted to others.
' Version 1.0 Stable
Public Function ExportXLS(TblA As String, TblB As String, Optional names As String, Optional specific As Boolean)
'****************'
'Set up variables'
'****************'
Dim ctrA As Integer
Dim ctrB As Integer
Dim var As Long
Dim str As String
Dim excel As Object 'Pointer to Excel Application
Dim book As Object 'Pointer to Excel Workbook
Dim sheet As Object 'Pointer to Excell Sheet
Dim Roster As DAO.Recordset
Dim Course As DAO.Recordset
Dim Child As DAO.Recordset
Dim last_name As DAO.Recordset 'Matrix of pointers that will hold parts of the tables to be printed to the corresponding Excel sheets
Dim course_name As DAO.Recordset 'Matrix of pointers that will hold parts of the tables to be printed to the corresponding Excel sheets
'********************************************************'
'Initialize our tables into thier recordsets for analysis'
'********************************************************'
Set Roster = CurrentDb.OpenRecordset(TblA)
Set Course = CurrentDb.OpenRecordset(TblB)
str = "SELECT Last FROM Roster"
Set last_name = CurrentDb.OpenRecordset(str)
str = "SELECT Course FROM [Course List]"
Set course_name = CurrentDb.OpenRecordset(str)
'**************************************************************************'
'Create the new excel file with default parameters and print the cover page'
'**************************************************************************'
Set excel = CreateObject("Excel.Application")
Set book = excel.Workbooks.Add
excel.Visible = True
Set sheet = book.Worksheets("Sheet1")
str = "Coversheet"
sheet.Name = str
sheet.Range("B2") = "HLC Database Export tool V1.0"
sheet.Range("B3") = "Written by Levi T Jackson, RN, BSN"
sheet.Range("B4") = "All rights reserved, Copyright 2021"
sheet.Range("B5") = "For use only by Emory Healhtcare, and others with permissions"
'**********************************'
'Main Loop, where the magic happens'
'**********************************'
ctrA = 0
Roster.MoveFirst
last_name.MoveFirst
Do Until last_name.EOF 'Move through the list of last names in the table Roster, one at a time
If Roster!Active = True Then 'No need to report on inactive employees, use access query for that
Set Child = Roster!Completion.Value 'Open a Recordset for the multivalued field Completion in Roster
ctrB = 1
If Child.EOF = True Then 'save the number of records for printing, or set to 0
var = 0
Else
Child.MoveLast
var = Child.RecordCount
Child.MoveFirst
End If
Course.MoveLast
If Child.EOF = False Then 'Avoid errors by not processing a page if no completion records exist
Set sheet = book.sheets.Add(After:=book.Worksheets(book.Worksheets.count)) 'For active employees, make a new sheet and switch to it, and set its name to the current last name from Roster
sheet.Activate
sheet.Range("A1").SELECT
str = Roster!Last & ", " & Roster!First
sheet.Name = str
sheet.Range("B2") = "Courses Completed"
Do Until Child.EOF 'If there are records in Completion for the current name, print them, move on when done
Course.MoveFirst
course_name.MoveFirst
Do Until Course.EOF
If Course![Course ID] = CInt(Child!Value.Value) Then
sheet.Range("D" & Mid(coordinates(ctrB), 2, Len(coordinates(ctrB)) - 1)) = Course![Course ID] 'prints course ID next to the name
sheet.Range("D2") = "'" & CStr(var) & " / " & CStr(Course.RecordCount) 'Prints number of records in completions
sheet.Range("B3") = "Course Name"
sheet.Range("D3") = "Course ID"
sheet.Range(coordinates(ctrB)) = Course!Course 'Prints course name
ctrB = ctrB + 1
Course.MoveLast
Course.MoveNext
Else
Course.MoveNext
course_name.MoveNext
End If
Loop
Child.MoveNext
Loop
End If
ctrA = ctrA + 1 'I might use this later in code updates, counts how manmy records are processed
Child.Close
excel.ActiveSheet.Cells.SELECT 'Selects all of the cells
excel.ActiveSheet.Cells.EntireColumn.AutoFit 'Does the "autofit" for all columns
sheet.Range("A1").SELECT 'Selects the first cell to unselect all cells
End If
Roster.MoveNext
last_name.MoveNext
Loop
'Clean up recordsets
last_name.Close
course_name.Close
Roster.Close
Set Roster = Nothing
Course.Close
Set Course = Nothing
End Function
'Converts the iteration of the print course sub loop into a sheet coordinate cell and returns it as a string
'This function is here so that later a more complicated printing coordinate system can be easily added as the database grows larger
Private Function coordinates(num As Integer) As String
coordinates = "B" & CStr(num + 4)
End Function
Add an order by clause to your OpenRecordset statements.
I am using the code from Function to export query or table to MS Excel to export all the data from one Access table to a worksheet in MS Excel.
This program stores time in and time out of employees in the table.
Let's say the admin wants to filter the data from 01 Jan 19 to 15 Jan 19.
I want to put two datepickers on my form as a basis for the "From" and "To".
I want to export that selected data. How can I inject that to this code?
Public Function Export2XL(InitRow As Long, DBAccess As String, DBTable As String) As Long
Dim cn As New ADODB.Connection 'Use for the connection string
Dim cmd As New ADODB.Command 'Use for the command for the DB
Dim rs2 As New ADODB.Recordset 'Recordset return from the DB
Dim MyIndex As Integer 'Used for Index
Dim MyRecordCount As Long 'Store the number of record on the table
Dim MyFieldCount As Integer 'Store the number of fields or column
Dim ApExcel As Object 'To open Excel
Dim MyCol As String
Dim Response As Integer
Set ApExcel = CreateObject("Excel.application") 'Creates an object
ApExcel.Visible = True 'This enable you to see the process in Excel
pExcel.Workbooks.Add 'Adds a new book.
ApExcel.ActiveSheet.Name = "" & (Export_data.Label1.Caption) & ""
'Set the connection string
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;data source=" &
app.Path & "\Dbase.mdb; User ID=admin;Persist Security Info=False;JET
OLEDB:Database Password=akgtrxx21"
'Open the connection
cn.Open
'Check that the connection is open
If cn.State = 0 Then cn.Open
Set cmd.ActiveConnection = cn
cmd.CommandText = DBTable
cmd.CommandType = adCmdTable
Set rs2 = cmd.Execute
'Count the number of fields or column
MyFieldCount = rs2.Fields.count
'Fill the first line with the name of the fields
For MyIndex = 0 To MyFieldCount - 1
ApExcel.Cells(InitRow, (MyIndex + 1)).Formula = rs2.Fields(MyIndex).Name
'Write Title to a Cell
ApExcel.Cells(InitRow, (MyIndex + 1)).Font.Bold = True
ApExcel.Cells(InitRow, (MyIndex + 1)).Interior.ColorIndex = 36
ApExcel.Cells(InitRow, (MyIndex + 1)).WrapText = True
Next
'Draw border on the title line
MyCol = Chr((64 + MyIndex)) & InitRow
ApExcel.Range("A" & InitRow & ":" & MyCol).Borders.Color = RGB(0, 0, 0)
MyRecordCount = 1 + InitRow
'Fill the excel book with the values from the database
Do While rs2.EOF = False
For MyIndex = 1 To MyFieldCount
ApExcel.Cells(MyRecordCount, MyIndex).Formula = rs2((MyIndex - 1)).Value
'Write Value to a Cell
ApExcel.Cells(MyRecordCount, MyIndex).WrapText = False 'Format the Cell
Next
MyRecordCount = MyRecordCount + 1
rs2.MoveNext
If MyRecordCount > 50 Then
Exit Do
End If
Loop
'Close the connection with the DB
rs2.Close
'Return the last position in the workbook
Export2XL = MyRecordCount
Set cn = Nothing
Set cmd = Nothing
Set rs2 = Nothing
Set ApExcel = Nothing
End Function
Excel does have a way to import data from Access with no VBA at all.
Create the connection to fill your worksheet.
Go to Menu Data > Access.
You will be asked to pick an Access database and select the table you want. You probably want a query to be executed but for now, pick any table; this will be edited later.
Edit the query to what you want.
Open the connection window by clicking on the menu Data > Connections and pick the connection you have just created. Then, go to the next tab (Definition), change Command Type from Table to SQL then in command text, type your command.
Don't close the window just yet.
Add condition on your date.
If the field is called, for instance, MyDate, then add a WHERE clause like this one: (MyDate >= ? AND MyDate <= ?).
When you refresh the data, you will be prompted to give values to replace the 2 question marks, and you will have the option to designate a cell to do it. You will also have an option for the query to always use what you have defined.
Note that when done correctly, you can reorder fields and/or create formulae in the table without causing any sort of problem to Excel at all. You can also create a Total row at the bottom to sum up values, using a formula (Excel will show you a dropdown to create a SUBTOTAL formula, that is conveniently sensitive to filters.
If you want to refresh data with VBA, it takes a single line of code to do: ThisWorkbook.Connections(...).Refresh or ApExcel.Workbooks(..).Connections(...).Refresh.
PS: If you absolutely want to keep your code above, then at least make sure not to copy rs2 cell by cell (that is way to slow due to Excel event handling) but rather, do something like: ApExcel.Cells(2, 1).CopyFromRecordset rs2
Right now I am trying to export data from Excel to Access with VBA.
rst("2k2").Value = sProduct
This is an example of what I currently use which is putting the value sProduct into the column in Access called "2k2". How would I move to the next column in Access and put a value in that column? Besides the obvious using the name of that column.
Thanks!
You could set the fields to a variable and cycle through them.
Dim fld as DAO.Field
for each fld in rst.fields
'Do some stuff
next
Disclaimer: As mentioned in the comments, do not use this code in a production environment. Use it only for a DB, which you are using for a school project or anything similar. Databases are really different than an Excel Spreadsheet and the position of the columns is not always constant.
Having said this:
Option Explicit
Public Function GetColumnNameAfter(columnName As String) As String
Dim cnLogs As New ADODB.Connection
Dim rsHeaders As New ADODB.Recordset
Dim rsData As New ADODB.Recordset
Dim myCounter As Long
Dim myConn As String
Dim nameFound As Boolean
myConn = "Provider=SQLNCLI11;Server=(localdb)\MSSQLLocalDB;"
myConn = myConn & "Initial Catalog=Blog;Trusted_Connection=yes;timeout=30;"
cnLogs.Open myConn
With rsHeaders
.ActiveConnection = cnLogs
.Open "SELECT * FROM syscolumns WHERE id=OBJECT_ID('Posts')"
Do While Not rsHeaders.EOF
'Printing is fun...
'Debug.Print rsHeaders(0)
If nameFound Then
GetColumnNameAfter = rsHeaders(0)
Exit Function
End If
If columnName = rsHeaders(0) Then nameFound = True
myCounter = myCounter + 1
rsHeaders.MoveNext
Loop
.Close
End With
End Function
In the strConn change the Initial Catalog to your DB and the DB Table Posts here OBJECT_ID('Posts')" to your DB table. Then the function will return the String name of the column after the the one you have provided as a parameter.
The code loops through the Headers of a table, named "Posts", which is in a DB named Blog. Once it finds a header, named columnName, it sets the nameFound to True and returns the Name of the next column.
Once you know the name of the "Next" column, you can use the same logic as in your question.
Currently the following SQL query in Excel VBA shows the count data vertically
So the column header is in A1 and the count result is in B1
Const sqlconnection = "Provider=visoledb;"
Dim conn As New Connection
conn.ConnectionString = sqlconnection
conn.Open
Dim rs As Recordset
Dim r1 As String
r1 = "SELECT COUNT(*) FROM user"
Set rs = conn.Execute(r1)
With ActiveSheet.QueryTables.Add(Connection:=rs, Destination:=Range("A1"))
.Refresh
End With
rs.close
Is it possible to have it show the header text in A1 and the count value in A2?
So it shows vertically across the cells in a single row left to right
I took a look at your code and got it working, but I only had a local database to test it on so I used DAO- this wont work for you if you only have a connection string unfortunately, but if you have the full filepath of the DB then you can use this code directly, if not then hopefully the syntax helps you figure out the missing step in your OCDB code, they are very similar.
Second, I think there is something wrong with your SQL Query String- I don't think it does what you think it does. When you say you want the data 'across the cells in a single row left to right' but a SELECT COUNT(*) query is only going to return 1 field so you are only going to have 1 column...
Anyways, here is the code doing what you want it to- hopefully once you have tinkered with the SQL String you'll have all the pieces you need to get it working:
Public Sub sampleCode()
Dim targetWS As Worksheet
Dim db As DAO.Database
Dim SQLString As String
Dim rs As DAO.Recordset
Set targetWS = ThisWorkbook.Sheets(1)
Set db = Access.DBEngine.Workspaces(0).OpenDatabase("C:\DB File.accdb")
SQLString = "SELECT COUNT(*) FROM [user]"
Set rs = db.OpenRecordset(SQLString)
rs.MoveLast
rs.MoveFirst
With targetWS.QueryTables
.Add Connection:=rs, Destination:=Range("A1")
.Item(1).Refresh
End With
db.Close
End Sub
Hope this helps,
TheSilkCode