Access Query with Variable and Export to Excel - vba

When pressing a button I would like to execute a SQL statement which uses a variable.
For example:
SELECT a, b,
FROM data
WHERE a IS NOT NULL
AND b = '&<Variable>&';
Then the result of the query shall be exported into a worksheet of an Excel file.

You might have to create a SQL on the fly and save it for the DoCmd.OutputTo method to do the export for you. Something like.
Option Compare Database
Option Explicit
Sub ExportQueryToExcel()
Dim dbObj As DAO.Database, qdObj As DAO.QueryDef
Dim filePath As String, sqlText As String, yourVariable As String
Set dbObj = CurrentDb
yourVariable = "Apple"
sqlText = "SELECT a, b, c WHERE a Is Not Null And b = '" & yourVariable & "'"
filePath = "C:\Users\P\Desktop\fileName.xlsx"
On Error Resume Next
With dbObj
.QueryDefs.Delete "tmpDataQry"
Set qdfNew = .CreateQueryDef("tmpDataQry", sqlText)
.Close
End With
On Error GoTo 0
DoCmd.OutputTo acOutputQuery, "tmpDataQry", acFormatXLSX, filePath
Set qdObj = Nothing
Set dbObj = Nothing
End Sub

Related

SQL VBA: Selecting all tables with specific table name and field name

im working with access and VBA. As for now, I am trying to create a query with a SQL statement.
I have a bunch of tables, all of them are named "innen" at the end and they vary at the start. Each of these tables contain the column name "OP" (also other field names). Now my goal is to select all tables with the name containing '%innen' and the column name "OP". So far i tried this:
Sub Aktuell()
Dim strSQL As String
Dim db As DAO.Database
Set db = CurrentDb
Dim qdf As QueryDef
strSQL = "SELECT [*].OP FROM MSysObjects WHERE TABLE_NAME LIKE '%innen' ORDER BY MAX;"
db.Execute strSQL
Set qdf = CurrentDb.CreateQueryDef("NewQuery8", strSQL)
DoCmd.OpenQuery qdf.Name
End Sub
i tried this here aswell:
strSQL = "SELECT * " & _
"FROM INFORMATION_SCHEMA.TABLES " & _
"WHERE COLUMN_NAME = 'OP_Datum';"
But i keep getting errors.
Any ideas? does it even work with a sql statement via vba?
Here is a VBA solution for you.
Option Compare Database
Function GetFieldList(TableName As String) As String()
On Error GoTo Er
Dim Flds() As String
Dim fc As Long
Dim I As Long
'Initialize Dynamic Flds() Array
Flds = Split("")
fc = CurrentDb.TableDefs(TableName).Fields.Count - 1
If fc >= 0 Then
ReDim Preserve Flds(fc)
For I = 0 To fc
Flds(I) = CurrentDb.TableDefs(TableName).Fields(I).Name
Next I
End If
Done:
GetFieldList = Flds
Erase Flds
Exit Function
Er:
Resume Done
End Function
Sub flTest()
Dim I As Long
Dim Fields As Variant
Fields = GetFieldList("Customers")
If UBound(Fields) = -1 Then
MsgBox "Table Not Found, or Table has no fields", vbCritical + vbOKOnly
Exit Sub
End If
For I = LBound(Fields) To UBound(Fields)
Debug.Print """" & Fields(I) & """"
Next I
End Sub
I'll bet there is a way to so the same thing using nothing but SQL. Although, Access is a unique animal. You can do this using SQL Server. I'm not 100% sure Access can handle it. Well, why not try it and see for yourself.

Access VBA - qdf parameters item not found - error 3265

I can't seem to understand what I've done wrong here. I'm getting an error 3265 (Item not found in this collection) at the three lines starting with "qdf.Parameters..." My understanding is that I define the where clause of my sql statement here, but maybe I'm wrong? Pretty new to vba with access so a little confused.
Sub Save_Invoices_Meet_Criteria()
Dim FileName As String
Dim FilePath As String
Dim myStmt As String
Dim Db As DAO.Database
Dim myrs As DAO.Recordset
Set Db = CurrentDb()
Dim qdf As DAO.QueryDef
Set qdf = Db.QueryDefs("qryCreateInvoicesApproved")
qdf.Parameters("[Forms]![frmAccountingDatabaseInput]![Invoice_approved]") = [Forms]![frmAccountingDatabaseInput]![Invoice_approved]
qdf.Parameters("[Forms]![frmAccountingDatabaseInput]![invoice_date]") = [Forms]![frmAccountingDatabaseInput]![Combo272]
qdf.Parameters("[Forms]![frmAccountingDatabaseInput]![Invoice_Type}") = [Forms]![frmAccountingDatabaseInput]![Combo274]
Set myrs = CurrentDb.OpenRecordset("SELECT distinct [reference] from qryCreateInvoicesApproved", 2)
Do Until myrs.EOF
FileName = Me.reference
foldername = Format(Now(), "YYYY-MM-DD")
FilePath = "C:\Users\company\Desktop\Invoicing Database\Save_Test\" & foldername & "\" & FileName & ".pdf"
DoCmd.OpenReport "RPTInvoice", acFormatPDF, FilePath
'DoCmd.OutputTo acOutputReport, , acFormatPDF, FilePath
DoCmd.Close
myrs.MoveNext
Loop
myrs.Close
Set myrs = Nothing
End Sub
My sql statement:
SELECT tblAccountingDatabase.*
FROM tblAccountingDatabase
WHERE (((tblAccountingDatabase.Invoice_approved)=Yes) And ((tblAccountingDatabase.invoice_date)=Forms!frmAccountingDatabaseInput!Combo272) And ((tblAccountingDatabase.Invoice_Type)=Forms!frmAccountingDatabaseInput!Combo274));
Simply add a PARAMETERS line at the beginning of your stored query which you then reference in the VBA querydef object. Then use the Querydef.OpenRecordset() method to pass parameterized query into a recordset object. Right now you are passing named parameters that do not exist:
SQL
PARAMETERS [Approveparam] YesNo, [Dateparam] Datetime, [Typeparam] String;
SELECT DISTINCT [reference]
FROM tblAccountingDatabase
WHERE (((tblAccountingDatabase.Invoice_approved) = [Approveparam])
AND ((tblAccountingDatabase.invoice_date) = [Dateparam])
AND ((tblAccountingDatabase.Invoice_Type) = [Typeparam]));
VBA
...
Dim qdf As DAO.QueryDef
Set qdf = Db.QueryDefs("qryCreateInvoicesApproved")
qdf!Approveparam = [Forms]![frmAccountingDatabaseInput]![Invoice_approved]
qdf!Dateparam = [Forms]![frmAccountingDatabaseInput]![Combo272]
qdf!Typeparam = [Forms]![frmAccountingDatabaseInput]![Combo274]
Set myrs = qdf.OpenRecordset()
...
To pass parameters to a form/report/macro that uses the same paramterized query use DoCmd.SetParameter method. And yes, you need to wrap every value with quotes hence the quote escaping. Also use DoCmd.OutputTo to convert report to PDF:
DoCmd.SetParameter "Approveparam", _
"""" & [Forms]![frmAccountingDatabaseInput]![Invoice_approved] & """"
DoCmd.SetParameter "Dateparam", _
"""" & [Forms]![frmAccountingDatabaseInput]![Combo272] & """"
DoCmd.SetParameter "Typeparam", _
"""" & [Forms]![frmAccountingDatabaseInput]![Combo274] & """"
DoCmd.OpenReport "RPTInvoice", acViewPreview
DoCmd.OutputTo acOutputReport, "RPTInvoice", acFormatPDF, FilePath
It kind of looks like you're trying to force yourself to use a parameter query but not really committed to it. If you don't want to truly use one you can change your SQL structure to use generic parameter names - and then use the qdf.Parameters method to fill the values from your form.
But I think this is the easiest for what you have now.
Replace these lines:
Dim qdf As DAO.QueryDef
Set qdf = Db.QueryDefs("qryCreateInvoicesApproved")
qdf.Parameters("[Forms]![frmAccountingDatabaseInput]![Invoice_approved]") = [Forms]![frmAccountingDatabaseInput]![Invoice_approved]
qdf.Parameters("[Forms]![frmAccountingDatabaseInput]![invoice_date]") = [Forms]![frmAccountingDatabaseInput]![Combo272]
qdf.Parameters("[Forms]![frmAccountingDatabaseInput]![Invoice_Type}") = [Forms]![frmAccountingDatabaseInput]![Combo274]
Set myrs = CurrentDb.OpenRecordset("SELECT distinct [reference] from qryCreateInvoicesApproved", 2)
With this line to open your recordset
Set myrs = qdf.OpenRecordset("SELECT * from qryCreateInvoicesApproved", 2)
Change your query to:
SELECT DISTINCT [reference]
FROM tblAccountingDatabase
WHERE (tblAccountingDatabase.Invoice_approved=[Forms]![frmAccountingDatabaseInput]![Invoice_approved])
AND (tblAccountingDatabase.invoice_date=Forms!frmAccountingDatabaseInput!Combo272)
AND (tblAccountingDatabase.Invoice_Type=Forms!frmAccountingDatabaseInput!Combo274);

Run time Error too few parameters Expected 2

I am trying to run a query from the Access Query designer that is working fine in Access but when I try to bring the statement across to VBA it is giving me this error message:
Run time error too few parameters. Expected 2.
I have printed the statement in the immediate window and run it in Access and it is running without asking for parameters. I have done a number of web searches the general consensus seems to be to declare it all in VBA, including the parameters -
Private Sub CmdAppend_Click()
Dim db1 As Database
Dim mystr As Recordset2
Dim UserName As String
Dim UpdateSQL As String
Dim SelectIDSQL As String
Dim checkstr As String
If Validate_Data = True Then
UserName = Environ$("Username")
SelectIDSQL = "Select Distinct ChecklistResults.[StaffID]" _
& " From ChecklistResults" _
& " Where (((ChecklistResults.[ClientID])=[Forms]![TeamLeader]![ComClientNotFin])" _
& " And ((ChecklistResults.[DateofChecklist])=[Forms]![TeamLeader]![ComDateSelect])" _
& " AND ((ChecklistResults.[ManagerID]) Is Null));"
Debug.Print SelectIDSQL
Set db1 = CurrentDb
Set mystr = db1.OpenRecordset(SelectIDSQL)
checkstr = mystr!StaffID
If checkstr <> UserName Then
I receive the above error message when I try to set mystr to the recordset. I think I can get the recordset by following the format below but is there a way of getting the above SQL statement/assignment to work?
Dim qdf1 As DAO.QueryDef
Set qdf1 = db1.QueryDefs("Get_StaffID")
qdf1.Parameters(0) = [Forms]![TeamLeader]![ComClientNotFin]
qdf1.Parameters(1) = [Forms]![TeamLeader]![ComDateSelect]
Set rst1 = qdf1.OpenRecordset(dbOpenDynaset)
As I look at this page, I see examples where the OpenRecordSet method takes two arguments. You have an error message that says something was expecting 2 parameters. Try changing this:
Set mystr = db1.OpenRecordset(SelectIDSQL)
to this:
Set mystr = db1.OpenRecordset(SelectIDSQL, dbOpenDynaset)
Thanks for the input, I used the following code to get the result I was looking for. It uses the query SelectClientID to return the ID of the person who completed the first stage of a checklist. it then checks the person who has done the second check and if they match it returns an error message. If two different people have completed it, it uses the SQL statement to update the previous record with the second checker's ID -
Private Sub CmdAppend_Click()
Dim rst1 As Recordset2
Dim db1 As Database
Dim mystr As Recordset2
Dim UserName As String
Dim UpdateSQL As String
Dim SelectIDSQL As String
Dim checkstr As String
Dim qdf1 As DAO.QueryDef
Set db1 = CurrentDb
Set qdf1 = db1.QueryDefs("SelectClientID")
qdf1.Parameters(0) = [Forms]![TeamLeader]![ComClientNotFin]
qdf1.Parameters(1) = [Forms]![TeamLeader]![ComDateSelect]
Set rst1 = qdf1.OpenRecordset(dbOpenDynaset)
If Validate_Data = True Then
UserName = Environ$("Username")
UpdateSQL = "UPDATE ChecklistResults" _
& " SET ChecklistResults.[ManagerID] = '" & UserName & "'" _
& " WHERE (((ChecklistResults.[ClientID])=[Forms]![TeamLeader]![ComClientNotFin])" _
& " AND ((ChecklistResults.[DateofChecklist])=[Forms]![TeamLeader]![ComDateSelect])" _
& " AND ((ChecklistResults.[ManagerID]) Is Null));"
checkstr = rst1!StaffID
If checkstr <> UserName Then
DoCmd.SetWarnings False
DoCmd.RunSQL UpdateSQL
DoCmd.SetWarnings True
DoCmd.Close
Else
MsgBox ("This Checklist was created by you and cannot therefore Checked by you")
End If
Else
Exit Sub
End If
End Sub

How to save the result of a SQL query into a variable in VBA?

I want to execute a select statement and put the result of it (which is only 1 record with 1 value) in a variable.
This is in VBA code in access.
Private Sub Child_Click()
Dim Childnummer As Integer
Dim childnaam As String
Childnummer = Me.Keuzelijst21.Value
DoCmd.Close
DoCmd.OpenForm "submenurubrieken", acNormal, , " rubrieknummer = " & Childnummer & ""
childnaam = rubrieknaamSQL(Childnummer)
Forms!submenurubrieken.Tv_rubrieknaam.Value = childnaam
End Sub
Public Function rubrieknaamSQL(Child As Integer)
Dim rst As DAO.Recordset
Dim strSQL As String
strSQL = "SELECT rubrieknaam FROM dbo_tbl_rubriek where rubrieknummer = " & Child & ""
Set rst = CurrentDb.OpenRecordset(strSQL)
End Function
Simply have your Function return the value from the Recordset:
Public Function rubrieknaamSQL(Child As Integer)
Dim rst As DAO.Recordset
Dim strSQL As String
strSQL = "SELECT rubrieknaam FROM dbo_tbl_rubriek where rubrieknummer = " & Child & ""
Set rst = CurrentDb.OpenRecordset(strSQL)
' new code:
rubrieknaamSQL = rst!rubrieknaam
rst.Close
Set rst = Nothing
End Function
You can do this in pretty much one line by using the "DLookup" Function
rubrieknaam = Nz(DLookup("rubrieknaam ", "dbo_tbl_rubriek ", rubrieknummer & " =[Child]"), 0)
where Child is the ID of the record you are looking for.

VBA DoCmd.TransferText - exporting query to .csv with user defined file path

Currently my code is this:
Dim testSQL As String
Dim qd As DAO.QueryDef
testSQL = "SELECT * FROM qryExample WHERE exampleID IN (" & strExampleIDList & ")"
Set qd = db.CreateQueryDef("tmpExport", testSQL)
DoCmd.TransferText acExportDelim, , "tmpExport", "C:\export.csv"
db.QueryDefs.Delete "tmpExport"
How do I change the "C:\export.csv" part so that the user is able to define the file path and the file name?
Thanks.
Assuming you want the user to be prompted for input, and then use that input in your TransferText call, try this:
Dim UserInput As String
UserInput = InputBox("Please enter the file path.", "I WANT A VALUE!")
DoCmd.TransferText acExportDelim, , "tmpExport", UserInput
There are other approaches out there, but this is perhaps the easiest to implement.
Good luck.
This example will allow you to use the filedialog Save-As object:
To use this function, you must add a reference to the "Microsoft Office XX.0 Object Library". Add a new module and paste the following function:
Public Sub exportQuery(exportSQL As String)
Dim db As DAO.Database, qd As DAO.QueryDef
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogSaveAs)
Set db = CurrentDb
'Check to see if querydef exists
For i = 0 To (db.QueryDefs.Count - 1)
If db.QueryDefs(i).Name = "tmpExport" Then
db.QueryDefs.Delete ("tmpExport")
Exit For
End If
Next i
Set qd = db.CreateQueryDef("tmpExport", exportSQL)
'Set intial filename
fd.InitialFileName = "export_" & Format(Date, "mmddyyy") & ".csv"
If fd.show = True Then
If Format(fd.SelectedItems(1)) <> vbNullString Then
DoCmd.TransferText acExportDelim, , "tmpExport", fd.SelectedItems(1), False
End If
End If
'Cleanup
db.QueryDefs.Delete "tmpExport"
db.Close
Set db = Nothing
Set qd = Nothing
Set fd = Nothing
End Sub
Now within your code where you want to start the export, use:
Call exportQuery("SELECT * FROM...")
I recommend defining a string variable for your SQL query.
Public Sub someButton_Click()
Dim queryStr as String
'Store Query Here:
queryStr = "SELECT * FROM..."
Call exportQuery(queryStr)
End Sub