I google a lot and read all post here related to this issue but found nothing that could give an explanation or help me to resolve this issue.
Following here, a function which work great when the "TableName" parameter is a base table but raise error when it is an ms access view (query). I found nothing yet that could explain this issue as many access query already refer to such views (queries) without issues.
Function DBDistinctCount(FieldName As String, tableName As String) As Long
Dim rs As Recordset, curDb As Database, strSql As String
On Error GoTo ERR_Handling
Set curDb = CurrentDb
'strSql = "SELECT COUNT(PR.[" & FieldName & "]) AS CNT FROM (SELECT [" & FieldName & "] FROM " & TableName & " GROUP BY [" & FieldName & "]) AS PR;"
strSql = "SELECT COUNT(PR." & FieldName & ") AS CNT FROM (SELECT " & FieldName & " FROM " & tableName & " GROUP BY " & FieldName & ") AS PR;"
'strSql = "SELECT COUNT([" & FieldName & "]) AS CNT FROM (SELECT [" & FieldName & "] FROM [" & TableName & "] GROUP BY [" & FieldName & "]);"
'Debug.Print result: SELECT COUNT(PR.ID_Projet) AS CNT FROM (SELECT ID_Projet FROM R_CompilationProjet GROUP BY ID_Projet) AS PR
' Dim qdf As DAO.QueryDef
' Set qdf = curDb.CreateQueryDef(vbNullString, strSql)
Set rs = curDb.OpenRecordset(strSql)
' Set rs = qdf.OpenRecordset(dbOpenSnapshot)
DBDistinctCount = Nz(rs.Fields("CNT"), 0)
ERR_Handling:
If Err.Number <> 0 Then
Dim mess As String
mess = "Erreur vba " & Err.Number & " : " & Err.Description
On Error Resume Next
Call DBHelper.AddLog(mess, "DBDistinctCount")
End If
If Not rs Is Nothing Then rs.Close
Set rs = Nothing
If Not curDb Is Nothing Then curDb.Close
Set curDb= Nothing
End Function
As you can see, I messed up the function a bit in order to find out what could be wrong. I even tried to use a querydef with the same result. I should mention that I've tried to put the resulting sql string itself inside an access query to see exactly the expected result when I ran the query. Any advice would be greatly appreciated.
I use the following code in vba access to update a column of a table, but it is not working. Please help me.
Best regards.
Dim sqlupdate As String
sqlupdate = "UPDATE Assay" _
& "SET Assay.assay_repeat = " & 0 & "" _
& "WHERE (((Assay.[assay_repeat])= " & 1 & "));"
DoCmd.RunSQL sqlupdate
You have an extra double quote and are missing a couple of spaces - try it like this:
Dim sqlupdate As String
sqlupdate = "UPDATE Assay" _
& " SET Assay.assay_repeat = " & 0 & " _
& " WHERE (((Assay.[assay_repeat])= " & 1 & "));"
You just missed space chars at end of the table name and before where.
Dim sqlupdate As String
sqlupdate = "UPDATE Assay " _
& "SET Assay.assay_repeat = " & 0 & " " _
& "WHERE (((Assay.[assay_repeat])= " & 1 & "));"
Here is a great way to convert a SQL string to VBA code.
Creating the form
The form just needs two text boxes, and a command button. SQL statements can be quite long, so you put the text boxes on different pages of a tab control.
Create a new form (in design view.)
Add a tab control.
In the first page of the tab control, add a unbound text box.
Set its Name property to txtSql.
Increase its Height and Width so you can see many long lines at once.
In the second page of the tab control, add another unbound text box.
Name it txtVBA, and increase its height and width.
Above the tab control, add a command button.
Name it cmdSql2Vba.
Set its On Click property to [Event Procedure].
Click the Build button (...) beside this property.
When Access opens the code window, set up the code like this:
Private Sub cmdSql2Vba_Click()
Dim strSql As String
'Purpose: Convert a SQL statement into a string to paste into VBA code.
Const strcLineEnd = " "" & vbCrLf & _" & vbCrLf & """"
If IsNull(Me.txtSQL) Then
Beep
Else
strSql = Me.txtSQL
strSql = Replace(strSql, """", """""") 'Double up any quotes.
strSql = Replace(strSql, vbCrLf, strcLineEnd)
strSql = "strSql = """ & strSql & """"
Me.txtVBA = strSql
Me.txtVBA.SetFocus
RunCommand acCmdCopy
End If
End Sub
http://allenbrowne.com/ser-71.html
I recommend you use Recordsets.
Private Sub Update_My_Records(Parent As Object)
Dim Data_Recset As Object
Dim Parent_Reference As Object
Set Data_Recset = Parent_Reference.Application.DBEngine.Workspaces(0).Databases(0).OpenRecordset("SELECT * FROM Assay WHERE assay_repeat = " & 0 & ";", DB_OPEN_DYNASET)
Data_Recset.MoveLast
Data_Recset.MoveFirst
Data_Recset.Edit
Data_Recset.Fields("assay_repeat") = 1
Data_Recset.Update
Data_Recset.Close
Set Data_Recset = Nothing
End Sub
assumptions
Parent has reference to Access.Application. (I usually pass: Form.Module.Parent reference to Sub/Function)
the table or query "Assay" already exists.
You only need to update 1 row at a time
But if you want to use Queries In Your Form:
Private Sub Query_Definition_Update()
Dim Obj_Qdef As Object
Dim Query_Name As String
Query_Name = "Q_Assay"
Me.Form.Application.DBEngine.Workspaces(0).Databases(0).QueryDefs.Refresh
Set Obj_Qdef = Me.Form.Application.DBEngine.Workspaces(0).Databases(0).QueryDefs(Query_Name)
Obj_Qdef.SQL = Query_Update(1)
Debug.Print Obj_Qdef.SQL
Obj_Qdef.Execute
''When finished updating
Obj_Qdef.Close
Set Obj_Qdef = Nothing
End Sub
'------------------------------------------------------------'
Private Function Query_Update(New_Value as Integer) As String
Query_Update = "UPDATE Assay" & _
" SET Assay.assay_repeat = " & 0 & "" & _
" WHERE (((Assay.[assay_repeat])= " & New_Value & "));"
End Sub
I can't figure out the error. I already tried adding more parentheses but this didn't help. This code checks to see if there is already a query called "InsertFilmZip" and if there isn't one, it creates it with the given statement. For some reason, it's saying that there is a Run-time error 3139: Syntax error in PARAMETER clause but I can't find the error.
Private Sub Command8_Click()
Dim dbsCurrent As Database
Set dbsCurrent = CurrentDb
Dim query As QueryDef
Dim sql As String
Dim item_val As String
item_val = Me.Text314
For Each query In CurrentDb.QueryDefs
If query.Name = "InsertFilmZip" Then
Exit For
End If
Next query
If query Is Nothing Then
sql = "parameters " & "P1 Number" & _
"INSERT INTO [tbl_FilmZipInfo] " & _
"(qty_per_unit) " & _
" VALUES ([P1])" & _
"WHERE (((tbl_FilmZipInfo.qty_per_unit)='" & Me.Text314 & "'))"
Set query = CurrentDb.CreateQueryDef("InsertFilmZip", sql)
End If
query.Parameters("P1").Value = Me.Text317
query.Execute
End Sub
Your SQL doesn't make sense, so try this adjustment:
sql = "parameters P1 Long;" & _
"UPDATE [tbl_FilmZipInfo] " & _
"SET qty_per_unit = [P1] " & _
"WHERE qty_per_unit = " & Me.Text314 & ""
In a nutshell: I'm making a scheduler for my client and, due to constraints, it needs to be in a single excel file (as small as possible). So one worksheet works as the UI and any others will be tables or settings.
I'm trying to use SQL (to which I'm new) to work with the schedule data on a single worksheet (named "TblEmpDays"). So I need to add/update and retrieve records to/from this worksheet. I was able to get a SELECT query to work with some arbitrary data (and paste to a Range). However, I'm not able to get INSERT or UPDATE to work. I've seen it structured as INSERT INTO [<table name>$] (<field names>) VALUES (<data>);. However this gives me a run-time error "'-2147217900 (80040e14)' Syntax error in INSERT INTO statement."
I'm using VBA to write all of this and I made an SQL helper class to make the query execution easier.
To clarify, my question is: How do I need to construct the INSERT and UPDATE queries? What am I missing? I'm trying to post as much related info as possible, so let me know if I missed anything.
Class SQL:
Private pCn ' As Database
Private pResult 'As Recordset
Private pSqlStr As String
Public Property Get Result()
Result = pResult
End Property
Public Function Init()
Set pCn = CreateObject("ADODB.Connection")
With pCn
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=""Excel 12.0 Macro;HDR=YES;ReadOnly=False"";"
.Open
End With
End Function
Public Function Cleanup()
If Not (pCn Is Nothing) Then
pCn.Close
Set pCn = Nothing
End If
If Not pResult Is Nothing Then
Set pResult = Nothing
End If
End Function
Public Function CopyResultToRange(rg As Range)
If Not rg Is Nothing And Not pResult Is Nothing Then
rg.CopyFromRecordset pResult
End If
End Function
Public Property Get query() As String
query = pSqlStr
End Property
Public Property Let query(value As String)
pSqlStr = value
End Property
Public Function Execute(Optional sqlQuery As String)
If sqlQuery = "" Then
sqlQuery = query
End If
If Not pCn Is Nothing Then
Set pResult = pCn.Execute(sqlQuery, , CommandTypeEnum.adCmdText Or ExecuteOptionEnum.adExecuteNoRecords)
Else
MsgBox "SQL connection not established"
End If
End Function
Executing function:
Dim s As SQL ' this is the SQL class '
Dim tbl As String
' rcDay=date string, rcIn & rcOut = time strings, rcVac=boolean string, rcSls=number string'
Dim rcName As String, rcDay As String, rcIn As String, rcOut As String, rcVac As String, rcSls As String
Dim qry As String
tbl = "[TblEmpDays$]"
qry = "INSERT INTO <tbl> (name, date, in, out, vac, sales)" & vbNewLine & _
"VALUES ('<name>', '<date>', '<in>', '<out>', '<vac>', <sales>);"
' Set rc* vars '
s.Init
s.query = Replace(Replace(Replace(Replace(Replace(Replace(Replace(qry, _
"<tbl>", tbl), _
"<sales>", rcSls), _
"<vac>", rcVac), _
"<out>", rcOut), _
"<in>", rcIn), _
"<date>", rcDay), _
"<name>", rcName)
MsgBox s.query
s.Execute
s.Cleanup
I've looked all over an can't find a solution. I'm sure I just haven't searched the right phrase or something simple.
I'm posting the solution here since I can't mark his comment as the answer.
Thanks to #Jeeped in the comments, I now feel like an idiot. It turns out three of my field names were using reserved words ("name", "date", and "in"). It always seems to be a subtle detail that does me in...
I renamed these fields in my worksheet (table) and altered the appropriate code. I also had to Cast the input strings into the proper data types. I'm still working the rest of the details out, but here's the new query:
qry = "INSERT INTO <tbl> (empName, empDay, inTime, outTime, vac, sales)" & vbNewLine & _
"VALUES (CStr('<name>'), CDate('<date>'), CDate('<in>'), CDate('<out>'), " & _
"CBool('<vac>'), CDbl(<sales>));"
I needed the CDate() (instead of the #*#) so I could pass in a string.
So CDate('<date>') instead of #<date>#
Consider using a relational database as backend instead of a worksheet for your project. You can continue to use the UI spreadsheet as a frontend. As a Windows product, the Jet/ACE SQL Engine can be a working solution plus it allows multiple user with simultaneous access (with record-level locking). Additionally, Jet/ACE comes equipped with its own SQL dialect for Database Definition Language (DDL) and Database Maniupulation Language (DML) procedures. And Excel can connect to Jet/ACE via ADO/DAO objects. The only difference of Jet/ACE compared to other RDMS is that it is a file level database (not server) and you cannot create a database using SQL. You must first create the database file using VBA or other COM defined language.
Below are working examples of VBA scripts (Clients and Orders tables) in creating a database with DAO, creating tables with ADO, executing action queries, and copying a recordset to worksheet. Integrate these macros into your project. Use error handling and debug.Print to help develop your app. If you do not have MS Access installed, the .accdb file will show in directory but with blank icon. There will be no user interface to manage the file except via code.
Sub CreateDatabase()
On Error GoTo ErrHandle
Dim fso As Object
Dim olDb As Object, db As Object
Dim strpath As String
Const dbLangGeneral = ";LANGID=0x0409;CP=1252;COUNTRY=0"
strpath = "C:\Path\To\Database\File.accdb"
' CREATE DATABASE '
Set fso = CreateObject("Scripting.FileSystemObject")
Set olDb = CreateObject("DAO.DBEngine.120")
If Not fso.FileExists(strpath) Then
Set db = olDb.CreateDatabase(strpath, dbLangGeneral)
End If
Set db = Nothing
Set olDb = Nothing
Set fso = Nothing
MsgBox "Successfully created database!", vbInformation
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Exit Sub
End Sub
Sub CreateTables()
On Error GoTo ErrHandle
Dim strpath As String, constr As String
Dim objAccess As Object
Dim conn As Object
strpath = "C:\Path\To\Database\File.accdb"
' CONNECT TO DATABASE '
constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strpath & ";"
Set conn = CreateObject("ADODB.Connection")
conn.Open constr
' CREATE TABLES (RUN ONLY ONCE) '
conn.Execute "CREATE TABLE Clients (" _
& " ClientID AUTOINCREMENT," _
& " ClientName TEXT(255)," _
& " Address TEXT(255)," _
& " Notes TEXT(255)," _
& " DateCreated DATETIME" _
& ");"
conn.Execute "CREATE TABLE Orders (" _
& " OrderID AUTOINCREMENT," _
& " ClientID INTEGER," _
& " Item TEXT(255)," _
& " Price DOUBLE," _
& " OrderDate DATETIME," _
& " Notes TEXT(255)" _
& ");"
' CLOSE CONNECTION '
conn.Close
Set conn = Nothing
MsgBox "Successfully created Clients and Orders tables!", vbInformation
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Exit Sub
End Sub
Sub RetrieveDataToWorksheet()
On Error GoTo ErrHandle
Dim strpath As String, constr As String
Dim conn As Object, rs As Object
Dim fld As Variant
strpath = "C:\Path\To\Database\File.accdb"
' OPEN CONNECTION '
constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strpath & ";"
Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
conn.Open constr
rs.Open "SELECT * FROM Clients" _
& " INNER JOIN Orders ON Clients.ClientID = Orders.ClientID;", conn
' COPY FROM RECORDSET TO WORKSHEET '
Worksheets(1).Activate
Worksheets(1).Range("A4").Select
' COLUMN NAMES '
For Each fld In rs.Fields
ActiveCell = fld.Name
ActiveCell.Offset(0, 1).Select
Next
' ROW VALUES '
Worksheets(1).Range("A5").CopyFromRecordset rs
' CLOSE RECORDSET AND CONNECTION '
rs.Close
conn.Close
Set conn = Nothing
Set rs = Nothing
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Exit Sub
End Sub
Sub ActionQueries()
On Error GoTo ErrHandle
Dim strpath As String, constr As String
Dim conn As Object
strpath = "C:\Path\To\Database\File.accdb"
' OPEN CONNECTION '
constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strpath & ";"
Set conn = CreateObject("ADODB.Connection")
conn.Open constr
' APPEND QUERY '
conn.Execute "INSERT INTO Clients (ClientID, ClientName)" _
& " VALUES (" & Worksheets(1).Range("A2") & ", '" & Worksheets(1).Range("B2") & "');"
conn.Execute "INSERT INTO Orders (ClientID, Item, Price)" _
& " VALUES (" & Worksheets(1).Range("A2") & ", " _
& "'" & Worksheets(1).Range("C2") & "', " _
& Worksheets(1).Range("D2") & ");"
' UPDATE QUERY '
conn.Execute "UPDATE Clients " _
& " SET Address = '" & Worksheets(1).Range("E2") & "'" _
& " WHERE ClientID = " & Worksheets(1).Range("A2") & ";"
' DELETE QUERY '
conn.Execute "DELETE FROM Orders " _
& " WHERE ClientID = " & Worksheets(1).Range("A2") & ";"
' CLOSE CONNECTION '
conn.Close
Set conn = Nothing
MsgBox "Successfully updated database!", vbInformation
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Exit Sub
End Sub
rs2.FindFirst "[aniin] ='" & strTemp & "'"
aniin being an alias from the SQL within the function.
also tried ...
rs2.FindFirst (niin = newdata)
is my attempt to isolate the field name niin from the record value in the form from the one in the strSQL2. All my attempts have failed. I am trying to make sure that what the user typed in does match the list from the SQL string.
Private Function IsPartOfAEL(newdata) As Boolean
On Error GoTo ErrTrap
Dim db2 As DAO.Database
Dim rs2 As DAO.Recordset
Dim strTemp As String
strSQL2 = "SELECT tbl_ael_parts.master_ael_id, tbl_master_niin.niin as aniin " & vbCrLf & _
"FROM tbl_master_niin INNER JOIN tbl_ael_parts ON tbl_master_niin.master_niin_id = tbl_ael_parts.master_niin_id " & vbCrLf & _
"WHERE (((tbl_ael_parts.master_ael_id)= " & Forms!frm_qry_niin_local!master_ael_id & "));"
Set db2 = CurrentDb
Set rs2 = db2.OpenRecordset(strSQL2)
strTemp = newdata
If rs2.RecordCount <> 0 Then
rs2.FindFirst "[aniin] ='" & strTemp & "'"
If rs2.NoMatch Then
IsPartOfAEL = False
Else
IsPartOfAEL = True
End If
Else
MsgBox "Query Returned Zero Records", vbCritical
Exit Function
End If
rs.Close
Set rs2 = Nothing
Set db2 = Nothing
ExitHere:
Exit Function
ErrTrap:
MsgBox Err.description
Resume ExitHere
End Function
First: You should never include a constant like vbCrLf when building a query string. The query parser doesn't care if there's a linefeed, and in fact this can sometimes cause issues.
Your code seems to do nothing more that verify whether the value in newdata exists in the tbl_ael_parts and is associated with the value master_ael_id value currently showing on frm_qry_niin_local. If so, then just use DCount, or use this for your query:
strSQL2 = "SELECT tbl_ael_parts.master_ael_id INNER JOIN tbl_ael_parts ON
tbl_master_niin.master_niin_id = tbl_ael_parts.master_niin_id WHERE (((tbl_ael_parts.master_ael_id)=
" & Forms!frm_qry_niin_local!master_ael_id & ") AND niin=" & newdata & ");"
Dim rst As DAO.Recordset
Set rst = currentdb.OPenrecordset(strsql2)
If (rst.EOF and rst.BOF) Then
' no records returned
Else
' records found
End If
If niin is a Text field:
strSQL2 = "SELECT tbl_ael_parts.master_ael_id INNER JOIN tbl_ael_parts ON
tbl_master_niin.master_niin_id = tbl_ael_parts.master_niin_id WHERE (((tbl_ael_parts.master_ael_id)=
" & Forms!frm_qry_niin_local!master_ael_id & ") AND (niin='" & newdata & "'));"
If both niin and master_ael_id are Text fields:
strSQL2 = "SELECT tbl_ael_parts.master_ael_id INNER JOIN tbl_ael_parts ON
tbl_master_niin.master_niin_id = tbl_ael_parts.master_niin_id WHERE (((tbl_ael_parts.master_ael_id)=
'" & Forms!frm_qry_niin_local!master_ael_id & "') AND (niin='" & newdata & "'));"