MS Access VBA QueryDef - With Block variable not set error - vba

When using QueryDef i receive the following error "Object
variable or With block variable not set". when i copy the output of strSQL to a new Query it works fine. Please assist in the solution for this error.
The error occurs when running the following line;
Set qryDef = dbs.CreateQueryDef(strQueryName, strSQL)
See Entire code below
Private Sub ComboReclassify_AfterUpdate()
Dim dbs As Database
Dim strSQL As String
Dim strQueryName As String
Dim qryDef As QueryDef
strQueryName = "qryST_ReclassifyAttribute"
Dim attr As String
Dim ValueID As Integer
attr = [Forms]![frm_tblST_AttributesReclassification]![ComboItemAttributes]
ValueID = [Forms]![frm_tblST_AttributesReclassification]![ComboReclassify]
strSQL = "UPDATE dbo_tblST_DepartmentsAttributes SET " & (attr) & " = " & ValueID & " WHERE dbo_tblST_DepartmentsAttributes.id = 1"
Set qryDef = dbs.CreateQueryDef(strQueryName, strSQL)
DoCmd.OpenQuery "qryST_ReclassifyAttribute"
End Sub

You seemed to have missed setting the dbs object.
Private Sub ComboReclassify_AfterUpdate()
Dim dbs As Database
Dim strSQL As String
Dim strQueryName As String
Dim qryDef As QueryDef
strQueryName = "qryST_ReclassifyAttribute"
Dim attr As String
Dim ValueID As Integer
attr = [Forms]![frm_tblST_AttributesReclassification]![ComboItemAttributes]
ValueID = [Forms]![frm_tblST_AttributesReclassification]![ComboReclassify]
strSQL = "UPDATE dbo_tblST_DepartmentsAttributes SET " & (attr) & " = " & ValueID & " WHERE dbo_tblST_DepartmentsAttributes.id = 1"
'You have not set the dbs object. That is the problem
Set dbs = CurrentDB
Set qryDef = dbs.CreateQueryDef(strQueryName, strSQL)
DoCmd.OpenQuery "qryST_ReclassifyAttribute"
End Sub
Once you set it. It should work as normal !

Related

Using QDEF in VBA

I am trying to update a local table in an Access database using a value passed from a click event. I want to add checkmarks to a column in the table for all the same values as the record that was clicked. What am I doing wrong with the QDEF?
Public Sub addcheckmarks(functionLocation As String)
Dim strsql As String
Dim qdef As QueryDef
strsql = "PARAMETERS [CheckLocation] String; UPDATE tbl_TMP_inventory set addlocation = -1 where Location = [CheckLocation]"
Set qdef = CurrentDb.createQueryDefs("", strsql)
qdef!CheckLocation = functionLocation
qdef.Execute dbFailOnError
End Sub
You don't have to build a temporary query for a simple update:
Public Sub addcheckmarks(functionLocation As String)
Dim strsql As String
strsql = "UPDATE tbl_TMP_inventory SET addlocation = True WHERE Location = '" & functionLocation & "'"
CurrentDb.Execute strsql
End Sub

Access Export Subform to excel

I'm trying to write some VBA to export filtered records from a subform. I've found a number of post related to this issue and I've cobbled the code below from those post.
When I run it I get a run-time error saying:
the Object '__temp' already exist.
When I click debug it highlights the line
Set qrydef = db.CreateQueryDef(strTempQryDef, strSQL)
Thank you for you help.
Private Sub ExportSubform()
Dim db As dao.Database
Dim qrydef As dao.QueryDef
Dim strSQL As String
Dim bolWithFilterOn As Boolean
Dim strTempQryDef As String
Dim strRecordSource As String
strTempQryDef = "__temp"
bolWithFilterOn = me.subsearch_frm.Form.FilterOn
strRecordSource = me.subsearch_frm.Form.RecordSource
If InStr(strRecordSource, "SELECT ") <> 0 Then
strSQL = strRecordSource
Else
strSQL = "SELECT * FROM [" & strRecordSource & "]"
End If
' just in case our sql string ends with ";"
strSQL = Replace(strSQL, ";", "")
If bolWithFilterOn Then
strSQL = strSQL & _
IIf(InStr(strSQL, "WHERE ") <> 0, " And ", " Where ") & _
me.subsearch_frm.Form.Filter
End If
Set db = CurrentDb
'create temporary query
Set qrydef = db.CreateQueryDef(strTempQryDef, strSQL)
db.QueryDefs.Append qrydef
Set qrydef = Nothing
DoCmd.TransferSpreadsheet TransferType:=acExport, _
SpreadsheetType:=acSpreadsheetTypeExcel12Xml, _
TableName:=strTempQryDef, _
FileName:=Replace(CurrentProject.Path & "\", "\\", "\") & strTempQryDef & ".xlsx"
' Delete the temporary query
db.QueryDefs.Delete strTempQryDef
Set db = Nothing
End Sub
Per the documentation:
If the object specified by name is already a member of the QueryDefs collection, a run-time error occurs.
As such, you should delete the temporary query before attempting to create it. To do this, you could use code along the lines of the following:
On Error Resume Next
DoCmd.DeleteObject acQuery, strTempQryDef
On Error GoTo 0
Also, per the documentation:
In a Microsoft Access workspace, if you provide anything other than a zero-length string for the name when you create a QueryDef, the resulting QueryDef object is automatically appended to the QueryDefs collection.
As such, you don't need this line:
db.QueryDefs.Append qrydef

Vba Access error 91

I try to run this code
Public Sub Production_UpdateStatus(ByVal lngProductionId As Long, _
ByVal NewProductionStatus As eProductionStatus)
Dim oDb As DAO.Database
Dim oRst As DAO.Recordset
Dim StrSql As String
Dim strProductionStatus As String
On Error GoTo Err_Infos
GetCurrentProductionStatusString NewProductionStatus, strProductionStatus
Set oDb = CurrentDb
'Mise a jour du staut de production
StrSql = "UPDATE tProduction SET tProduction.Statut= '" & strProductionStatus & "'" _
& " WHERE (tProduction.IdProduction=" & lngProductionId & ");"
oDb.Execute StrSql
'Fermeture des connexions
oRst.Close
oDb.Close
Set oDb = Nothing
Set oRst = Nothing
Exit_currentSub:
Exit Sub
Err_Infos:
MsgBox "Erreur #" & Err.Number & " : " & Err.Description
Resume Exit_currentSub
End Sub
This code work but give me error 91.
Object variable or With block variable not set
It generate the following SQL query :
UPDATE tProduction SET tProduction.Statut= 'Nouvelle' WHERE (tProduction.IdProduction=2);
When I test direct query, I do not have any error. Could you help me to eliminate this error ?
Thanks
You are closing a recordset object, oRst, that was never initialized with Set. Because you run an action query you do not need a recordset and it may have lingered from prior code versions.
On that same note, because you are passing literal values to an SQL query, consider parameterizing with DAO QueryDef parameters that avoids concatenation and quote enclosures:
Dim oDb As DAO.Database, qdef As DAO.QueryDef
Dim StrSql As String, strProductionStatus As String
GetCurrentProductionStatusString NewProductionStatus, strProductionStatus
Set oDb = CurrentDb
StrSql = "PARAMETERS strProductionStatusParam Text(255), lngProductionIdParam Long;" _
& " UPDATE tProduction SET tProduction.Statut = [strProductionStatusParam]" _
& " WHERE (tProduction.IdProduction = [lngProductionIdParam]);"
Set qdef = oDb.CreateQueryDef("", StrSql)
qdef!strProductionStatusParam = strProductionStatus
qdef!lngProductionIdParam = lngProductionId
qdef.Execute dbFailOnError
Set qdef = Nothing
Set oDb = Nothing
Try to remove the oRst related code lines. This variable is not initialized and not used.

Transfer memo from Excel 2010 to Access 2010 using VBA and DAO

I'm trying to transfer a text from Excel 2010 to Access 2010. Due to the limitation of 256 characters for normal text I want to use memo. Now, after hours of searching I still have no solution to my problem.
To be more specific:
This code reads the data (in this case text) and writes it into an Access data base. Due to the limitation for text I need to use Memo fields in the Access data base but after adjusting everything I couldn't find the data type for this statement (sSQL).
What I want to do is to change the following code: (reduced slightly to the relevant bits)
Dim ws As DAO.Workspace
Dim db As DAO.Database
Dim sDb As String
Dim sSQL As String
Dim qdf As QueryDef
sDb = ActiveWorkbook.Path & "\DataBase.accdb"
Set ws = DBEngine.Workspaces(0)
Set db = ws.OpenDatabase(sDb)
sSQL = "Parameters" _
& " SomeText Text; " _ <<== Here << ==
& "INSERT INTO IT_Ticker (SomeText)" _
& " Values ([ SomeText ])"
Set qdf = db.CreateQueryDef("", sSQL)
qdf.Parameters!SomeText = Worksheets("SomeSheet").Range("A1")
qdf.Execute dbFailOnError
Debug.Print qdf.RecordsAffected
qdf.Close
db.Close
ws.Close
Set qdf = Nothing
Set db = Nothing
Set ws = Nothing
I was thinking about replacing "Text" with "Memo" but it wasn't working. I also tried "LongText" and "String".
I'm assuming that the table into which you are appending data IT_Ticker already exists. You were not specific about the Parameters you're using, but the code below works just fine.
Option Explicit
Sub test()
Dim ws As DAO.Workspace
Dim db As DAO.Database
Dim sDb As String
Dim sSQL As String
Dim qdf As QueryDef
Dim userName As String
Dim longText As String
sDb = ActiveWorkbook.Path & "\DataBase2.accdb"
Set ws = DBEngine.Workspaces(0)
Set db = ws.OpenDatabase(sDb)
'sSQL = "Parameters" _
'& " SomeText Text; " _ <<== Here << ==
'& "INSERT INTO IT_Ticker (SomeText)" _
'& " Values ([ SomeText ])"
userName = Cells(2, 2).Value
longText = Cells(3, 2).Value
sSQL = "INSERT INTO IT_Ticker (UserName, ReallyLongText) Values (""" & _
userName & """,""" & longText & """)"
Set qdf = db.CreateQueryDef("", sSQL)
'qdf.Parameters!SomeText = Worksheets("SomeSheet").Range("A1")
qdf.Execute dbFailOnError
Debug.Print qdf.RecordsAffected
qdf.Close
db.Close
ws.Close
Set qdf = Nothing
Set db = Nothing
Set ws = Nothing
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.