Query error on a recordset.update vba line - vba

I am trying to print multiple labels for multiple records. The number of labels is consistent for any one run of the label report and all labels for the same record need to be together on the printed sheet. Parameters are entered on TakeNoticeForm and once a button is clicked a recordset, rsQuery, is created with TakeNoticeLabelQuery. Another recordset is created, rsTable, based on a table, TemporaryTNLabels. This table is a copy of my main table, Certificates, without data. I'm using nested For loops to parse through the query results and add "x" copies of said record into the temp table, which will then be used to print the labels. Once the labels are printed the data will be cleared from the temp table for use again later.
Everything I have so far appears to work until I actually start adding data to my temp table. I get Error 3991 - "The query failed to execute because the identifier '[Certificates].[TownshipID]' could not be found" and it points to .Update. [TownshipID] is a lookup field in the Certificates table that was the original for TemporaryTNLabels. I tried to keep the copy intact for possible reuse with other reports but I don't need that field for this report so deleted the lookup field from the temp table to hopefully solve the problem. TakeNoticeLabelQuery is actually a copy of another query, TakeNoticeQuery, that did reference Township information. Again, I was hoping to reuse objects but made a copy and only kept what I needed, which has no reference to TownshipID.
After stripping everything unnecessary away, I can't figure out why it's still trying to find [TownshipID]. I'm still trying to wrap my head around recordsets so wondering if the problem is actually elsewhere, buty I'm confused as to how this error is even remotely related to my code. Any help is appreciated. The SQL for the query and code for generating label data are below.
SELECT Certificates.DatabaseID, Certificates.CertCounty, Certificates.TaxYear, Certificates.ParcelNumber, Certificates.MailToFirstName, Certificates.MailToLastName, Certificates.MailToAlso, Certificates.MailToCity, Certificates.MailToState, Certificates.MailToZip
FROM Counties INNER JOIN Certificates ON Counties.ID = Certificates.CertCounty
WHERE (((Certificates.DatabaseID) Between ([Forms]![TakeNoticeForm]![FirstDBTextbox]) And ([Forms]![TakeNoticeForm]![LastDBTextbox])) AND ((Certificates.CertCounty) Like [Forms]![TakeNoticeForm]![CountyCombobox] & '*') AND ((Certificates.TaxYear) Like [Forms]![TakeNoticeForm]![TaxYearTextbox] & '*')) OR (((Certificates.CertCounty) Like [Forms]![TakeNoticeForm]![CountyCombobox] & '*') AND ((Certificates.TaxYear) Like [Forms]![TakeNoticeForm]![TaxYearTextbox] & '*') AND ((IsNull([Forms]![TakeNoticeForm]![FirstDBTextbox]))<>False) AND ((IsNull([Forms]![TakeNoticeForm]![LastDBTextbox]))<>False));
Option Compare Database
Option Explicit
Private Sub TNLabelPreviewButton_Click()
Dim iTab As Integer
Dim iLabel As Integer
Dim numLabels As Integer
Dim totalRecords As Long
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rsTable As DAO.Recordset
Dim rsQuery As DAO.Recordset
' Set query definition for creating recordset
Set db = CurrentDb()
Set qdf = db.QueryDefs("TakeNoticeLabelQuery")
If CurrentProject.AllForms("TakeNoticeForm").IsLoaded Then
qdf.Parameters("[Forms]![TakeNoticeForm]![FirstDBTextbox]") = [Forms]![TakeNoticeForm]![FirstDBTextbox]
qdf.Parameters("[Forms]![TakeNoticeForm]![LastDBTextbox]") = [Forms]![TakeNoticeForm]![LastDBTextbox]
qdf.Parameters("[Forms]![TakeNoticeForm]![CountyCombobox]") = [Forms]![TakeNoticeForm]![CountyCombobox]
qdf.Parameters("[Forms]![TakeNoticeForm]![TaxYearTextbox]") = [Forms]![TakeNoticeForm]![TaxYearTextbox]
' qdf.Parameters("[Forms]![TakeNoticeForm]![TakeNoticeDateTextbox]") = [Forms]![TakeNoticeForm]![TakeNoticeDateTextbox]
Else
qdf.Parameters("[Forms]![TakeNoticeForm]![FirstDBTextbox]") = ""
qdf.Parameters("[Forms]![TakeNoticeForm]![LastDBTextbox]") = ""
qdf.Parameters("[Forms]![TakeNoticeForm]![CountyCombobox]") = ""
qdf.Parameters("[Forms]![TakeNoticeForm]![TaxYearTextbox]") = ""
' qdf.Parameters("[Forms]![TakeNoticeForm]![TakeNoticeDateTextbox]") = CStr(Date)
End If
Set rsQuery = qdf.OpenRecordset
rsQuery.MoveLast
totalRecords = rsQuery.RecordCount
'Close and delete records from TemporaryTNLabels table.
DoCmd.SetWarnings False
DoCmd.Close acTable, "TemporaryTNLabels"
DoCmd.RunSQL "DELETE FROM [TemporaryTNLabels]"
DoCmd.SetWarnings True
numLabels = Me.NumLabelsTextbox
MsgBox numLabels & " labels"
'Open a table-type Recordset
Set rsTable = db.OpenRecordset("TemporaryTNLabels", dbOpenTable)
rsQuery.MoveFirst
With rsTable
For iTab = 1 To totalRecords
For iLabel = 1 To numLabels
Debug.Print rsQuery!DatabaseID
.AddNew
!ParcelNumber = rsQuery!ParcelNumber
.Update ' <-------------------------This is where the error points.
.Bookmark = .LastModified
Next iLabel
rsQuery.MoveNext
Next iTab
End With
' DoCmd.OpenReport ReportName:="TakeNoticeLabelReport", View:=acViewPreview
rsTable.Close
Set rsQuery = Nothing
Set qdf = Nothing
Set db = Nothing
End Sub

This is why I stopped using lookup fields :-( I would delete the table TemporaryTNLabels or rename it to TemporaryTNLabels_OLD. Then recreate the table TemporaryTNLabels from scratch with only one field ParcelNumber, and start from there.

Related

Access VBA - AfterUpdate() Recordset edit leads to "No current Record 3021" even if Record exists

I have an issue where I was not able to find a solution by tinkering and searching similiar problems already solved on the web.
First:
Im'using a form to enter a component ID (CID). After entering the Number in the Field I'm making use of the AfterUpdate() function to use the CID to look up a corresponding Prod ID in another Table. The Matching Prod ID from the other Table will then be entered automaticaly into the field. The field is a multivalued Field.
Here is the code:
Private Sub Form_AfterUpdate()
Dim rst As DAO.Recordset
Dim rstChld As DAO.Recordset2
Dim tmpVar
If Me.Dirty Then
Me.Dirty = False
End If
If StrComp(Me.Part, "Device") = 0 Then
tmpVar = DLookup("[Device Prod]", "subLookTblCIDDevice", "[CID Device] = '" & Me.CIDDevice & "'")
Set rst = Me.Recordset
If Me.Recordset.RecordCount = 0 Then
rst.MoveFirst
End If
If Not (rst.BOF And rst.EOF) Then
If rst.Updatable Then
rst.Edit
Set rstChld = rst!Prod.Value
rstChld.AddNew
rstChld.Fields(0) = tmpVar
rstChld.Update
rst.Update
Me.Bookmark = rst.LastModified
Set rst = Nothing
Set rstChld = Nothing
End If
End If
End If
End Sub
If the record exists and im Changing the CID - Everything is working fine the corresponding field gets its correct coresponding ID.
But if it is a new Record and the first of the recordset I got the error message
No Current Record - 3021
It can be mitigated by adding
If Me.Recordset.RecordCount = 0 Then
rst.MoveFirst
End If
But if its a new Record and not the first record it changes the previous record.
I have tried to use .AddNew instead of .Edit. This will create a new record after the one which has been updated.
I would be really glad if someone could have a look at it. I dont understand whats going on. why it is jumping before or after the record.
Thx and Cheers

The changes you requested to the table were not successful because they would create duplicate values

So I have a database with two tables. There is a primary key in both tables, AccountID which has a relationship.Image1 Image2Image3
DonationsTable HOAFeesTable(All the entries on the HOAFees table are just test entries, the data entered aren't important)
I have a form that adds records to the HOAFees table. The code on the form is designed to find if an AccountID exists in the table already and if it does it edits the record. If the ID is not on the table already, it should add the record.
`
Option Compare Database
Private Sub btnAddRecord_Click()
'Declare variables
Dim db As DAO.Database
Dim rst As Recordset
Dim intID As Integer
'Set the current database
Set db = Application.CurrentDb
'Set the recordset
Set rst = db.OpenRecordset("tblHOAFees", dbOpenDynaset)
'Set value for variable
intID = lstAccountID.Value
'Finds the Account ID selected on the form
With rst
rst.FindFirst "AccountID=" & intID
'If the record has not yet been added to the form adds a new record
If .NoMatch Then
rst.AddNew
rst!AccountID = intID
rst!HOAID = txtHOAID.Value
rst!Location = txtLocation.Value
rst!House = chkHouse.Value
rst!Rooms = txtRooms.Value
rst!SquareFeet = txtSquareFeet.Value
rst!HOAFees = txtHOAFees.Value
rst.Update
'If the Account ID is already in the form edits the record
Else
rst.Edit
rst!AccountID = intID
rst!HOAID = txtHOAID.Value
rst!Location = txtLocation.Value
rst!House = chkHouse.Value
rst!Rooms = txtRooms.Value
rst!SquareFeet = txtSquareFeet.Value
rst!HOAFees = txtHOAFees.Value
rst.Update
End If
End With
'Closes the recordset
rst.Close
Set rst = Nothing
Set db = Nothing
End Sub
`
It works without any issues when editing an existing record. But when I add a new record and then try to close the form I get this: ErrorImage The strange thing is though, when I click through all the errors and check the table. The new record is still added to the table despite it saying it can't save. How can I get this to stop coming up? Everything I keep finding is saying that an autonumber field is causing the error. But I don't have any auto number fields.
I've tried removing primary key from the HOAFees table, but it makes no difference. I need the primary key for the Donations table, so I can't change or have any duplicates on that.
If you don't have a problem with the error itself, and everything works fine, you just don't want the error message to appear, add code in the OnError event of the form, which checks if it's the error number you want to ignore.
Private Sub Form_Error(DataErr As Integer, Response As Integer)
Const ErrNumber = your_err_number
If DataErr = ErrNumber Then
Response = acDataErrContinue
End If
End Sub

Skip empty fields when adding a new record using vba

I have a form that users open to add new fees and services for clients. There are 10 fields for fees and I have it setup to auto-populate the fee verbiage if the user un-checks a "standard hourly rate" check box.
If they un-click Std-Hourly, then the field [Fee001] will go from being greyed out and blank, to display "Services # 1 through # 3...." and the user can edit the text if they need it to show "Services # 1 through #7" (depending on how many services the client has)
When the user clicks the Save button, I have the data then saved to TblFee_ByClient table. The table has a record for each service ([ClientID] and [Service] are the only 2 fields in this table) but the form itself has 10 fields ([Fee001], [Fee002], Fee003] and so on) that the user can edit/generate.
All works except my code also adds records for the fields that the user clears/deletes so that I have a record with [ClientID] and no service listed. How do I add code to skip fields that are empty? Here is the vba so far and I am getting an error "Argument not optional" on the "Move.Next":
Private Sub Toggle154_Click()
Dim TblFee_ByClient As DAO.Recordset
Set TblFee_ByClient = CurrentDb.OpenRecordset("SELECT * FROM [TblFee_ByClient]")
TblFee_ByClient.AddNew
TblFee_ByClient![ClientID] = Me.ClientID.Value
If Me.Fee001.Value Is Not Null Then
TblFee_ByClient![Fee] = Me.Fee001.Value
Else Move.Next
End If
TblFee_ByClient![ClientID] = Me.ClientID.Value
TblFee_ByClient![Fee] = Me.Fee002.Value
TblFee_ByClient.Update
TblFee_ByClient.Close
Set TblFee_ByClient = Nothing
End Sub
Correct syntax is TblFee_ByClient.MoveNext but don't see it's needed here.
Use IsNull() in VBA. Is Null is for queries. Or better, handle possibility of Null or empty string.
Don't open recordset with existing records.
Need a conditional statement for each of the 10 controls. This can be accomplished in a loop.
Private Sub Toggle154_Click()
Dim TblFee_ByClient As DAO.Recordset
Dim x As Integer, strFee As String
Set TblFee_ByClient = CurrentDb.OpenRecordset("SELECT * FROM [TblFee_ByClient] WHERE 1=0")
With TblFee_ByClient
For x = 1 To 10
strFee = "Fee" & Format(x, "000")
If Nz(Me(strFee), "") <> "" Then
.AddNew
!ClientID = Me.ClientID
!Fee = Me(strFee)
.Update
End If
Next
.Close
End With
Set TblFee_ByClient = Nothing
End Sub

VBA Access multiple replace

I have a table master with a memo field. This fileld content many abreviation of full text. The full text is on another table call nomemclature.
I want to make a multiple replace from the nomemclature table to the master table with the correspondant field.
I also have some problem with the abreviation field. The field has many error like space ans other caractere that l want not to replace.
How can i do the thing ?
You can use the code below. Use it as in the Test procedure. In the first recordset, supply the one field you want to process. In the secord recordset, supply the two fields for find and replace.
Public Sub Test()
Dim oRSetToProcess As Recordset
Dim oRSetFindReplace As Recordset
DoCmd.SetWarnings False
Set oRSetToProcess = CurrentDb.OpenRecordset("SELECT [MemoField] FROM [tblData];")
Set oRSetFindReplace = CurrentDb.OpenRecordset("SELECT [Find],[Replace] FROM [tblFindReplace];")
BulkReplace oRSetToProcess, oRSetFindReplace
oRSetToProcess.close
oRSetFindReplace.close
Set oRSetToProcess = Nothing
Set oRSetFindReplace = Nothing
DoCmd.SetWarnings True
End Sub
Public Sub BulkReplace(oRSetToProcess As Recordset, oRSetFindReplace As Recordset)
Dim sTempString As String
oRSetToProcess.MoveFirst
Do Until oRSetToProcess.EOF
sTempString = oRSetToProcess(0)
oRSetFindReplace.MoveFirst
Do Until oRSetFindReplace.EOF
sTempString = Replace(sTempString, oRSetFindReplace(0), oRSetFindReplace(1))
oRSetFindReplace.MoveNext
Loop
With oRSetToProcess
.Edit
.Fields(0) = sTempString
.Update
.MoveNext
End With
Loop
End Sub

Extract and display data from access table using VBA

I have a function to extract and then display a recordset in a listbox.
I only get one field in my listbox.
Is there a way I can display the whole column "Caption" (several fields) in the listbox?
Function GetCaption() As String
Dim db As Database
Dim rst As DAO.Recordset
Dim SQL As String
Dim LCaption As String
Set db = CurrentDb()
SQL = "SELECT Caption FROM tblMainMenu"
Set rst = db.OpenRecordset(SQL)
If rst.EOF = False Then
LCaption = rst("Caption")
Else
LCaption = "Not found"
End If
rst.Close
Set rst = Nothing
GetCaption = LCaption
End Function
Private Sub btnGetCaption1_Click()
LstBx.RowSourceType = "Value List"
LstBx.RowSource = GetCaption
End Sub
Private Sub Form_Load()
LstBx.RowSource = ""
btnGetCaption1.Caption = DLookup("ReportID", "tblMainMenu", "ReportID = 1")
End Sub
I'm not sure how well I understand your goal. But if you want the list box to contain tblMainMenu.Caption values, one per list box row, you can use the query as its Record Source.
With the form open in Design View, open the list box's property sheet, and select the Data tab. Then choose "Table/Query" for Row Source Type. Add this SQL for the Row Source property.
SELECT [Caption] FROM tblMainMenu
Then select the Format tab, and enter 1 for the Column Count property.
Finally switch to Form View and tell us whether that gives you what you want, or how it differs from what you want.