I have this table:
And I did the next query that works for sure:
SELECT tbl_Type.Id_Type,
tbl_Type.Info,
tbl_Type.Id_Table_Three_Plus_Info,
tbl_Type.DateX
FROM tbl_Type
WHERE (((tbl_Type.DateX)=[Write Date (dd/dd/yyy)]));
As you see in the query in the WHERE part there's an input of the column DateX.
Now I want to use same procedure but using a form for the input, the code to do that is this:
Private Sub btn_Action_Click()
On Error Resume Next
'DoCmd.SetWarnings False
Dim Fecha As String
Fecha = _
"SELECT tbl_Type.Id_Type, tbl_Type.Info, tbl_Type.Id_Table_Three_Plus_Info, tbl_Type.DateX FROM tbl_Type WHERE tbl_Type.DateX = txt_Date.value;"
CurrentDb.CreateQueryDef ([Nom],Fecha) As QueryDef
DoCmd.RunSQL Fecha
'DoCmd.Save Fecha, "s"
txt_Date = Null
End Sub
First, I want to know if it is well performed the input in the content of the String Fecha. As you see I'm giving that action when the button btn_Action is clicked and capturing the input for DateX with a Text Field txt_Date I would say that the query is working but I don't know how to see that, in that order I proceed to pretend to save that query, which is something desired too. I've seen in another question that for do that is used CurrentDb.CreateQueryDef I tried DoCmd.Save but I think that isn't the case. With CurrentDb.CreateQueryDef I'm having a syntax error. Am I missing something?
Please, if more details are needed, still is a silly question or things like that let me now, to do the correct procedure!
Consider simply saving a parameterized query and then in VBA bind your form value to parameter using QueryDef object. MS Access SQL maintains the PARAMETERS clause to set named placeholders. Below outputs parameterized query results to Excel workbook.
SQL (save below as a query, Ribbon > Create > Query Design > SQL View)
PARAMETERS DateParam Datetime;
SELECT t.Id_Type,
t.Info,
t.Id_Table_Three_Plus_Info,
t.DateX
FROM tbl_Type t
WHERE (((t.DateX)=[DateParam]));
VBA (calls query, bind parameters, export to new Excel workbook)
Private Sub btn_Action_Click()
On Error Goto ErrHandle
Dim xl_app As Object, xl_wb As Objcect
Dim qdef As QueryDef, rst As Recordset
' REFERENCE SAVED QUERY
Set qdef = CurrentDb.QueryDef("mySavedQuery")
' BIND PARAMETER
qdef!DateParam = txt_Date
' SET qdef TO RECORDSET
Set rst = qdef.OpenRecordset()
' EXPORT TO EXCEL
Set xl_app = CreateObject("Excel.Application")
Set xl_wb = xl_app.Workbooks.Add()
With xl_wb.Sheets(1)
' COLUMNS
For i = 1 To rst.Fields.Count
.Cells(1, i) = rst.Fields(i - 1).Name
Next i
' DATA
.Range("A2").CopyFromRecordset rst
End With
xl_app.Visible = True
txt_Date = Null
ExitHandle:
rst.Close()
Set rst = Nothing: Set qdef = Nothing
Set xl_wb = Nothing: Set xl_app = Nothing
Exit Sub
ErrHandle:
Msgbox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR"
Resume ExitHandle
End Sub
You have to concatenate the value of the input to your query string like so
Fecha = _
"SELECT tbl_Type.Id_Type, tbl_Type.Info, tbl_Type.Id_Table_Three_Plus_Info, tbl_Type.DateX FROM tbl_Type WHERE tbl_Type.DateX = " & txt_Date.value & ";"
To inspect the result, you should execute in debug mode (Press F8 instead of F5 in vba).
I'm trying to generate a report similar to a crosstab. The data are from a filtered form (Dates and WorkerID (String)).
form: frmReg
table with data: tReg
report: reportReg
On the following line:
Set qdf = dbsReport.QueryDefs(Me.RecordSource)
I'm getting the error:
Error 3265 Item not found in this collection
What am I doing wrong?
Private Sub Report_Open(Cancel As Integer)
' Create underlying recordset for report using criteria
Dim intX As Integer
Dim qdf As QueryDef
Dim frm As Form
' Don't open report if frmReg form isn't loaded.
If Not (IsLoaded("frmReg")) Then
Cancel = True
MsgBox "To preview or print this report, you must open " _
& "frmReg in Form view.", vbExclamation, _
"Must Open Dialog Box"
Exit Sub
End If
' Set database variable to current database.
Set dbsReport = CurrentDb
Set frm = Forms!frmReg
' Open QueryDef object.
' Set qdf = dbsReport.QueryDefs("ReportReg")
Me.RecordSource = "SELECT * FROM [tReg]"
Set qdf = dbsReport.QueryDefs(Me.RecordSource)
' Open Recordset object.
Set rstReport = qdf.OpenRecordset()
' Set a variable to hold number of columns in crosstab query.
intColumnCount = rstReport.Fields.Count
End Sub
It looks like the problem might be a relationship issue between the SQL and the commands and you probably do not have a query setup to take the information you are seeking.
Try this:
sSQL = "SELECT * FROM [tReg]"
Me.RecordSource = sSQL
Set qdf = dbsReport.CreateQueryDef("NewQuery", sSQL)
'This will purge the query after your inteactions are complete
dbsReport.QueryDefs.Delete "NewQuery"
Note: This will not include any interactions for the QueryDef.
The QueryDefs collection takes saved, named queries and not SQL statements. As #Jiggles32 demonstrates, you need to create a named query and then reference it with QueryDefs() call.
However, you can bypass the use of queries by simply directly opening recordsets with OpenRecordset() which is the end result of your needs:
strSQL = "SELECT * FROM [tReg]"
Me.RecordSource = strSQL
Set rstReport = dbsReport.OpenRecordset(strSQL)
' Set a variable to hold number of columns in crosstab query.
intColumnCount = rstReport.Fields.Count
In fact, you can directly extract a form's recordset using RecordsetClone property (preferred over Recordset if running various operations to not affect form's actual records):
strSQL = "SELECT * FROM [tReg]"
Me.RecordSource = strSQL
Set rstReport = Me.RecordsetClone
' Set a variable to hold number of columns in crosstab query.
intColumnCount = rstReport.Fields.Count
I'm attempting to create a macro that based on a user input (on an excel sheet) will pull data from a query I made in Access. In order for it to pull only the applicable lines (rows) of data it needs to edit the WHERE statement accordingly. I have adapted the following code from a previous question but I am running into issues when I try to replace the SQL.
Private Sub CommandButton4_Click()
Const DbLoc As String = "MYfilepath"
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim wb1 As Workbook, ws1 As Worksheet, ws2 As Worksheet, SQL As String, recCount As Long
Set wb1 = Workbooks("mytool.xlsm")
Set ws1 = wb1.Sheets("Inputs")
Set ws2 = wb1.Sheets("raw")
Set db = OpenDatabase(DbLoc)
Set userinput = ws1.Range("D6")
SQL = "SELECT Dock_Rec_Problems.Merch_Name, Dock_Rec_Problems.Vendor_Error_Code, Dock_Rec_Problems.DC, Dock_Rec_Problems.Vendor_ID_IP, Dock_Rec_Problems.Vendor_Name, Dock_Rec_Problems.PO_Number, Dock_Rec_Problems.SKU_No, Dock_Rec_Problems.Item_Description, Dock_Rec_Problems.Casepack, Dock_Rec_Problems.Retail, Dock_Rec_Problems.Num_Of_Cases, Dock_Rec_Problems.Dock_Rec_Problems_DGID"
SQL = SQL & "FROM Dock_Rec_Problems;"
SQL = SQL & "WHERE [Dock_Rec_Problems_DGID] =" & userinput
Set rs = db.OpenRecordset(SQL, dbOpenSnapshot)
If rs.RecordCount = 0 Then
MsgBox "Not found in database", vbInformation + vbOKOnly, "No Data"
GoTo SubExit
End If
ws2.Range("A1").CopyFromRecordset rs
SubExit:
On Error Resume Next
Application.Cursor = xlDefault
rs.Close
Set rs = Nothing
Exit Sub
End Sub
Let me know if there is anything I can clear up...thanks!
Original Query SQL
SELECT Dock_Rec_Problems.Merch_Name, Dock_Rec_Problems.Vendor_Error_Code,
Dock_Rec_Problems.DC, Dock_Rec_Problems.Vendor_ID_IP,
Dock_Rec_Problems.Vendor_Name, Dock_Rec_Problems.PO_Number,
Dock_Rec_Problems.SKU_No, Dock_Rec_Problems.Item_Description,
Dock_Rec_Problems.Casepack, Dock_Rec_Problems.Retail,
Dock_Rec_Problems.Num_Of_Cases, Dock_Rec_Problems.Dock_Rec_Problems_DGID
FROM Dock_Rec_Problems;
Single input SQL
SELECT Dock_Rec_Problems.Merch_Name, Dock_Rec_Problems.Vendor_Error_Code, Dock_Rec_Problems.DC, Dock_Rec_Problems.Vendor_ID_IP, Dock_Rec_Problems.Vendor_Name, Dock_Rec_Problems.PO_Number, Dock_Rec_Problems.SKU_No, Dock_Rec_Problems.Item_Description, Dock_Rec_Problems.Casepack, Dock_Rec_Problems.Retail, Dock_Rec_Problems.Num_Of_Cases, Dock_Rec_Problems.Dock_Rec_Problems_DGID
FROM Dock_Rec_Problems
WHERE (((Dock_Rec_Problems.Dock_Rec_Problems_DGID)="D040323000"));
Double input SQL
SELECT Dock_Rec_Problems.Merch_Name, Dock_Rec_Problems.Vendor_Error_Code, Dock_Rec_Problems.DC, Dock_Rec_Problems.Vendor_ID_IP, Dock_Rec_Problems.Vendor_Name, Dock_Rec_Problems.PO_Number, Dock_Rec_Problems.SKU_No, Dock_Rec_Problems.Item_Description, Dock_Rec_Problems.Casepack, Dock_Rec_Problems.Retail, Dock_Rec_Problems.Num_Of_Cases, Dock_Rec_Problems.Dock_Rec_Problems_DGID
FROM Dock_Rec_Problems
WHERE (((Dock_Rec_Problems.Dock_Rec_Problems_DGID)="D040323000")) OR (((Dock_Rec_Problems.Dock_Rec_Problems_DGID)="D040323012"));
Because the size of your user input is open-ended, consider using a temp table saved in MS Access with exact structure as your query (can be built with: SELECT * INTO temp_table FROM myquery). Then, with each call of the Excel macro:
Clean the temp table out with DELETE.
Iterate through the user input Excel range of cells to append needed rows to table with INSERT INTO...SELECT.
Create recordset from temp table.
And once again, here is a prime use case for SQL parameterization especially since the query receives user input. A clever, malicious user can potentially clean out your database! But at the very least, code is arguably more maintainable. Because you are using DAO, consider QueryDefs to bind parameter value to a prepared, saved query and then bind into a recordset.
SQL (save as an MS Access stored action query)
PARAMETERS [userparam] TEXT(255);
INSERT INTO Excel_Table (Merch_Name, Vendor_Error_Code, DC, Vendor_ID_IP,
Vendor_Name, PO_Number, SKU_No, Item_Description,
Casepack, Retail, Num_Of_Cases, Dock_Rec_Problems_DGID)
SELECT d.Merch_Name, d.Vendor_Error_Code, d.DC, d.Vendor_ID_IP,
d.Vendor_Name, d.PO_Number, d.SKU_No, d.Item_Description,
d.Casepack, d.Retail, d.Num_Of_Cases, d.Dock_Rec_Problems_DGID
FROM Dock_Rec_Problems d
WHERE d.[Dock_Rec_Problems_DGID] = [userparam];
VBA
...
Dim qdef As DAO.QueryDef
Dim cel As Range
Set qdef = db.QueryDefs("mySavedQuery")
' CLEAN OUT TEMP EXCEL TABLE
db.Execute "DELETE FROM Excel_Table"
' ITERATIVELY APPEND TO EXCEL TABLES
For Each cel In userinput.Cells
qdef!userparam = cel.Value ' BIND PARAM
qdef.Execute dbFailOnError ' EXECUTE ACTION
Next cel
' OPEN RECORDSET TO TABLE
Set rs = db.OpenRecordset("Excel_Table", dbOpenSnapshot)
If rs.RecordCount = 0 Then
MsgBox "Recieving problem not found in database", vbInformation+vbOKOnly, "No Data"
GoTo SubExit
End If
ws2.Range("A1").CopyFromRecordset rs
.......
There are a few problems with the code you've displayed. For instance, the strNewFields variable is attempted to be used, before you've set it to anything, here:
strNewSQL = strNewSQL & Replace(WHERE_FIELDS, "<INSERT FIELDS>", strNewFields)
At this point strNewFields is totally blank, but you're trying to do a replace.
I would suggest:
Change you WHERE_FIELDS Const from
Const WHERE_FIELDS As String = "WHERE " _
& "(((Dock_Rec_Problems.Dock_Rec_Problems_DGID) = <INSERT FIELDS>)); "
to
Const WHERE_FIELDS As String = "WHERE " _
& " [Dock_Rec_Problems].[Dock_Rec_Problems_DGID] IN (<INSERT FIELDS>); "
I find this easier to read then all the nested brackets, it removes the equals sign in preference of the IN() statement.
Now you want to populate the strNewFields variable with whatever inputs they gave you. Probably using a Do While Loop to iterate through the INPUTS. Each input is added to the strNewFields variable something like this.
Dim rs as Recordset
Set RS = currentdb.mydataset ' You need to modify this line
rs.Open
strNewFields = strNewFields & "'" & rs("InputFieldName") & "'"
rs.MoveNext
Do While rs.EOF = False
strNewFields = strNewFields & ",'" & rs("InputFieldName") & "'"
Loop
strNewFields = StrNewFields & ")"
Now that you have strNewFields populated you can simply run your replace()
Replace(WHERE_FIELDS, "<INSERT FIELDS>", strNewFields)
You need to look at the order in which you are setting variables though, as pointed out above, you've got some order of event issues.
Michael
I created a client database. In the database, each of the clients are grouped by a unique company ID. The user can search all the clients in the company by entering a company ID in the following cell on the main form.
([Forms]![frmNavigationForm]![Text78])
Right now I want to do mail merge from the subform to word after by clicking a button on the main form.
I got some ideas from the following link: Access and Word 2010 merging one record depending on subform button clicked
Issue:
When I try to run the code, it shows run time error "4198": Command Failed.
When I run debug the this command was highlighted
.OpenDataSource Name:=sData, SQLStatement:=strSQL
Can someone tell me how to fix the error?
Private Sub Command203_Click()
Dim mDoc As String
Dim strSQL As String
mDoc = "C:\~~~\800052 ENG w Macro titus.docx"
strSQL = "SELECT * FROM![frmNavigationForm]![frmKYCGenerator] WHERE [RS ID]=" & [Forms]![frmNavigationForm]![Text78]
Dim oApp As New Word.Application
Dim oMainDoc As Word.Document
Dim sData As String
oApp.Visible = True
Data = "C:\~~~\Database - Users - PR.accdb"
Set oMainDoc = oApp.Documents.Open(mDoc)
With oMainDoc.MailMerge
.MainDocumentType = wdFormLetters
.OpenDataSource Name:=sData, SQLStatement:=strSQL
End With
With oMainDoc
.MailMerge.Destination = wdSendToNewDocument
.MailMerge.Execute
End With
oApp.Activate
oApp.Documents.Parent.Visible = True
oApp.Application.WindowState = 1
oApp.ActiveWindow.WindowState = 1
Set oApp = Nothing
Set oMainDoc = Nothing
Exit Sub
Err_Handle:
Set oApp = Nothing
Set oMainDoc = Nothing
MsgBox "An error occurred..." & vbCrLf & vbCrLf & Err.Description
End Sub
Perhaps the name of your datasource is empty. I think that:
Data = "C:\~~~\Database - Users - PR.accdb"
should be:
sData = "C:\~~~\Database - Users - PR.accdb"
Add an Option Explicit to top of your module code.
That would find the issue identified by #peter and any other undeclared or typo error variables
It also looks like you merged a couple names together in your SQL
I assume you know what you're doing in your SQL statement - either you forgot the table name - or you're actually using the query/table defined by [frmNavigationForm]![frmKYCGenerator]
Because you don't mention any table name I'll assume the latter. In that case...
Change this
strSQL = "SELECT * FROM![frmNavigationForm]![frmKYCGenerator] WHERE [RS ID]=" & [Forms]![frmNavigationForm]![Text78]
To this
strSQL = "SELECT * FROM [" & [Forms]![frmNavigationForm]![frmKYCGenerator] & "] WHERE [RS ID]=" & [Forms]![frmNavigationForm]![Text78]
I am fetching a set of names from a database query and then reformatting it to a comma separated list. As I am using this functionallity a few Places in my app, I try to write it as a function getting the sql-query and returning the string.
Public Function String_from_query(StrSQL As String) As String
Dim dbs As Database
Dim rs As Recordset
Set dbs = CurrentDb
Dim results As String
results = ""
Set rs = dbs.OpenRecordset(StrSQL)
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
Do While Not rs.EOF
If results > "" Then
results = results & ", "
End If
results = results & rs("Navn")
rs.MoveNext
Loop
End If
Set String_from_query = results
End Function
This is then called from an event handler:
Private Sub Detalj_Format(Cancel As Integer, FormatCount As Integer)
Dim StrSQL As String
StrSQL = "SELECT Personer.Navn FROM Personer INNER JOIN Personoppgaver ON Personer.Initialer = Personoppgaver.Initialer WHERE Personoppgaver.Oppgaveid =" & Me.Oppgaveid.Value
Me.Tekst52.Value = String_from_query(StrSQL)
End Sub
If I have the code from the String_from_query function within the event handler and then directly assigns Me.Tekst52 to results, everything works fine. When I refactor the code as shown, I get a "Compile Error, Object required" when I try to run it and a marker on the last line in the sub. (Set String_from_query = results). I am not able to see what is wrong. Any help?
The keyword Set is only required when assigning variables to an Object. For Access, this would be Forms, Reports, Recordsets, etc. Or other Objects outside of Access (FileSystemObject, for example).
When setting strings, dates, numbers, etc, you do not need Set.
You can surmise this from the error message as well, Object required.