Run-time error 3022 with .AddNew

Hi all,

I have a problem with something that I thought would be very simple and trivial.

I have a table with three fields: an Autonumber field, a date field and a text field. I also have a form with a command button to add a new record. When I add the record for the first time it works fine. If/when I try add another record(s) it gives me run-time error 3022 (no duplicates allowed).

Here is my code:

	Private Sub cmdGetInMod_Click()
Dim intModID As Integer
Dim strTable as string
strTable = "tbl_TEST"
intModID = getInModID(strTable)
end Sub
Private Function getInModID(strTable As String) As Integer
Dim tempDB As DAO.Database
Dim tempRST As DAO.Recordset
Dim strSQL As String
Dim strUsername As String
Dim strDate As String
strUsername = Environ("username")
strDate = Date
strSQL = "SELECT * FROM " & strTable & ";"
Set tempDB = CurrentDb()
Set tempRST = tempDB.OpenRecordset(strSQL, dbOpenDynaset)
    With tempRST
        .Fields(1).Value = strDate
        .Fields(2).Value = strUsername
        .Update ' 

Post your answer or comment

comments powered by Disqus
Hi all,

I wrote this routine temporarily using a local table in my front-end database. No problems... however, when I changed it to use the linked table, I'm getting the famous (I've seen so many conversations concerning this...) VBA: 3251 error - Current provider does not support the necessary interface for Index functionality.

In, I found a Jan 27, 2009 Run-time error 3251 document stating that this error has been fixed in R06670 Service Pack. Has anyone downloaded this service pack and does it fix the 3251 problem?

Or - maybe something I can change in my code? From what I gather from my searching is I can't seek on either a primary or alt key with a linked table. I've asked for the download but I haven't received it yet.


Dim cnn As ADODB.Connection
Dim errCur As ADODB.Error
Dim lngValue As Long
Dim rstEmpSkill As ADODB.Recordset ' this will be tblEmployeeSkillSet
Dim varValueArray As Variant
' if nothing selected, exit
If Me.lstEmps.ItemsSelected.Count = 0 Or Me.lstTasks.ItemsSelected.Count = 0 Then
MsgBox "You must select at least one entry from both lists to continue", vbCritical
Exit Sub
End If
Set cnn = CurrentProject.Connection
Set rstEmpSkill = New ADODB.Recordset
rstEmpSkill.CursorType = adOpenDynamic
rstEmpSkill.LockType = adLockOptimistic
rstEmpSkill.Open "tblEmployeeSkillSet", cnn, , , adCmdTableDirect
rstEmpSkill.Index = "UniqueSkillSet" ' index is two long fields
Dim varItem As Variant
Dim varItem2 As Variant
' Enumerate through listbox selected items and if not duplicate on foreign key, add to tblEmployeeSkillSet.
' the two values from the lstbox contain the two long fields of the foreign key
For Each varItem In Me.lstEmps.ItemsSelected
For Each varItem2 In Me.lstTasks.ItemsSelected

varValueArray = Array(Me.lstEmps.ItemData(varItem), Me.lstTasks.ItemData(varItem2))
rstEmpSkill.Seek varValueArray, adSeekFirstEQ
If rstEmpSkill.EOF Then ' record doesn't exist, add it
rstEmpSkill.Fields("intEmployeeID") = Me.lstEmps.ItemData(varItem)
rstEmpSkill.Fields("intSkillID") = Me.lstTasks.ItemData(varItem2)
End If
Next varItem2
Next varItem
MsgBox "Your selections have been processed..."


I'm using a report with a Microsoft Graph 2000 chart on it. On this graph I'm setting some data labels on and off. This works well when opening the report for the first time. If I open it a second time with the same data it works well, too. But if I open it with different data (having fewer series) I get Run-time error '1004': Unable to set the HasDataLabel property for the Point class. Between the sessions I close the report completely. When I close the application completely and restart it then for the first time everything works well again!? Does the report save any data even if it is closed? Another surprinsing effect: It happens only if I open the report in print preview mode. But in between I closed the print preview so to me the report must be closed then...

	With cht.SeriesCollection(1)
    For i = 1 to .Points.count - n
        .Points(i).HasDataLabel = False
    Next i
End With

Thanks for help


I'm not a programmer but am putting together a search form. There was a search form sample shared on this site, and I've taken it and modified for my own use.

Here's how my version of the form is supposed to work:
When the user provides a text input for the search, a number of records that match the search criteria are displayed in the table. The user may select one of these records, and when they do so, the various fields of the record are displayed in editable text boxes below the table.

In my current form, the search works fine, but when the user selects a record, an error occurs and the record does not display in the text boxes underneath. It says: "run-time error 91: Object variable or With block variable not set"

The problem code is here, and the debugger points to the "Set rs=" line as the cause.

Private Sub QuickSearch_AfterUpdate()

Dim rs As Object

Set rs = Me.Recordset.Clone
rs.FindFirst "[DocumentID] = " & Str(Me![QuickSearch])
Me.Bookmark = rs.Bookmark

End Sub

Any idea what could be causing this in my form? It works fine for the original version. I'm in Access 2003, and the form was made for Access 2000, if that makes any difference.


I have a form and a subform. On my parent form I have a field called “Workdate” and a tab control on which I have put my subforms (on each tab a subform which are all related to the workdate on my parent form). The field “Workdate” is a unique field, so I can’t create double records for one workdate. Everytime I add a new record (workdate) I want to automatically add a few records in the subforms with VBA-code. Now, when I try to add a record I always get the following error message :

Run-time error “3201”
You cannot add or change a record because a related record is required in table “tblWorkdates”.

When I go to my code the error points to the following line in my code : .Update.

The problem is the record in my parent form needs to be saved first before I can add records in the subform. I've tried to put the line "docmd.runcommand accmdsaverecord" in the "Workdat_AfterUpdate" sub procedure but then I get another problem when I try to add a record with a workdate that already exists. Then I get a message form access saying I can't create double records. At that moment I'd like to see my own message (see Form_Error) instead of one from access itself.

So, what code do I need to save the record in my parent form and where do I have to put it. And what code do I need for showing my error message instead of the one from access.

This is my code so far :

Private Sub Workdate_AfterUpdate()

Dim db As Database
Dim rs1 As Recordset
Dim rs2 As Recordset

Set db = CurrentDb()
Set rs1 = db.OpenRecordset("Table1")
Set rs2 = db.OpenRecordset("Table2")

Do While Not rs1.EOF
With rs2
!MyField1 = Forms!MyForm!MyField1
!MyField2 = rs1!MyField2
End With



End Sub

Private Sub Form_Error(DataErr As Integer, Response As Integer)

Const conErrorDoubleRecords = 3022

If DataErr = conErrorDoubleRecords Then
ShowMessage "This workdate already exists in the database."
Response = acDataErrContinue
DoCmd.RunCommand acCmdUndo
Response = acDataErrDisplay
End If

End Sub

Anyone who knows how to solve this problem?

Thanks already.


Wonder if anyone can help.

I have inherretied another legacy.....this time a Timesheet database. I'm trying to cleanit up and iron out the issues....i wonder if anyone knows how to deal with this.....

When i try ti preview the timesheet i get the following error...

"Run-time error '7794'"
"Microsoft Access couldn;t find the toolbar 'print'"

The line of code it stops the debugger on is...

DoCmd.OpenReport stDocName, acViewPreview

where stDocName is the document to be printed. AcView Preview has the value '"2" in it when you put the cursor over it.

I'm stumped!

I have the following piece of code that updates a field in a table with a selected value from a list box

Dim varItm As Variant
If IsNull(Me.tb_Other1) Then
DoCmd.RunSQL "UPDATE Tbl_Section_1 SET Tbl_Section_1.ProgUsed =" & Me.Lb_Programmes.ItemData(varItm) & _
" Where" & [Tbl_Section_1]![UniqueID] = Me.Tb_UniqueId
DoCmd.RunSQL "UPDATE Tbl_Section_1 SET Tbl_Section_1.ProgUsed =" & Me.tb_Other1 & _
" Where" & [Tbl_Section_1]![UniqueID] = Me.Tb_UniqueId
End If

When run a run time error 2465 is returned. I think it is to do with the Where clause of the statement.

I am using the following to pass two items of data from a form to a Module -

	Call UpdatePerformanceAdd(StewID.Value, StartDate.Value)

The module is as follows -

	Public Sub UpdatePerformanceAdd(lStew_Num As Long, lStartDate As Date)
    Dim Dbs As Database: Set Dbs = CurrentDb
    Dim rstPerf As Recordset
    Dim rstFuture As Recordset
    Dim strSQL As String
    strSQL = "SELECT Performances.ID, Performances.Perf_Date, Performances.Duration FROM Performances "
    strSQL = strSQL & "WHERE (((Performances.Perf_Date)>=" & lStartDate & "));"
    Set rstPerf = Dbs.OpenRecordset(strSQL)
    Set rstFuture = Dbs.OpenRecordset("StewardAvailability", dbOpenDynaset)
    With rstFuture
        rstPerf.MoveLast: rstPerf.MoveFirst
        While Not rstPerf.EOF
            'add new record to availability table
            !Stewards_ID = lStew_Num     'copy performance id #
            !Perf_ID = rstPerf!ID       'copy staff ID number
            !Availability = False       'set availability to false
            !Memo = " "                  'Leave memo field blank
            !Duty_length = rstPerf!Duration 'copy duty duration
            .Update                     'update recordset
            rstPerf.MoveNext           'move to next contracted employee
    End With
    strSQL = ""
    Set Dbs = Nothing
End Sub

When I run this I get the following error "Run-Time error '424'; Object Required". The 'HeadID.Value' is a value from the database and this works fine. However, the StartDate.Value (which seems to be causing the error) is a text box in which the user enters a date to be used as part of the query in the module.

Anyone any ideas how to fix this?

When I put the following code in "after update" I get the run time error 429. ActiveX componet cannot create object.

Any suggestions would be greatly appeciated!

Public Sub SendMessage()
> Dim objOutlook As Outlook.Application
> Dim objOutlookMsg As Outlook.MailItem
> Dim objOutlookRecip As Outlook.Recipient
> Dim SafeItem
> Set SafeItem = CreateObject("Redemption.SafeMailItem")
> ' create the Outlook session
> Set objOutlook = CreateObject("Outlook.Application")
> ' create the Message
> Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
> SafeItem.Item = objOutlookMsg
> With SafeItem
> .Recipients.Add "MyRecipient"
> .Subject = "Testing"
> .Body = "This is a test of Redemption"
> '.Display
> .Save
> .Send
> End With
> Set objOutlookMsg = Nothing
> Set objOutlookMsg = Nothing
> Set SafeItem = Nothing
> End Sub

Hi all,
I'm trying to write some VB code, the user selects data using a form & when they hit ok it brings up a report displaying all the records that match.

The form has three combo boxes & two text boxes.

Commercial (combo)
Customer (Combo)
Status (combo)
Beginning Date (txt)
End Date (Txt)

So the user could be really specific & use all of the criteria to narrow down the records shown by selecting data in all options or just one/two combo boxes/text boxes.

E.g user selected Commercial 'Angie',
Beginning Date '10/1/2004'
End Date '10/30/2004'

I'm having a problem with a 'Run Time Error 13' 'Type mismatch'. I think it is something to with declaring the date in my Dim statement.

	Option Compare Database

Private Sub CmdApplyfilter_Click()

    Dim StrCommercial As String
    Dim StrCustomer As String
    Dim Date_Due As Date
    Dim StrStatus As String
    'Dim StrBusiness As String
    Dim StrFilter As String

    Date_Due = Date
'Code to automatically open report
    If SysCmd(acSysCmdGetObjectState, acReport, "rptRFQ Receipt to Tender Sent")  acObjStateOpen Then
       DoCmd.OpenReport "rptRFQ Receipt to Tender Sent", acViewPreview, StrFilter
    End If
'Build Criteria string for Commercial Staff
    If IsNull(Me.Cbocommercial.Value) Then
        StrCommercial = "Like '*'"
        StrCommercial = "='" & Me.Cbocommercial.Value & "'"
    End If
'Build Criteria string for Customer
    If IsNull(Me.CboCustomer.Value) Then
        StrCustomer = "Like '*'"
        StrCustomer = "='" & Me.CboCustomer.Value & "'"
    End If
'Build criteria for Date due for Beginning Date
    If IsNull(Me.txtbegdate.Value) Then
        Date_Due = "Like '*'"
        Date_Due = "='" & Me.txtbegdate.Value & "'"
    End If
'Build criteria for Date due for End Date
    If IsNull(Me.txtenddate.Value) Then
        Date_Due = "Like '*'"
        Date_Due = "='" & Me.txtenddate.Value & "'"
    End If

'Build Criteria string for Status
    If IsNull(Me.CboStatus.Value) Then
       StrStatus = "Like '*'"
        StrStatus = "='" & Me.CboStatus.Value & "'"
    End If
'Combine criteria strings into WHERE clause for the filter
    StrFilter = " [Commercial] " & StrCommercial & " AND [Customer] " & StrCustomer & " AND [Date Due] " & Date_Due & " AND
[Order Status] " & StrStatus
'Apply the filter and switch on
    With Reports![rptRFQ Receipt to Tender Sent]
        .Filter = StrFilter
        .FilterOn = True

    End With
End Sub

Any help would be greatly appreciated!

Thanks in advanced


Here is the code I am using:

	Public Sub STCMAssign()
Dim strSTCMWO As String, cnSTCM As ADODB.Connection, strPriority As String
Dim rstOrigInv As ADODB.Recordset, MyConn As String, sqlSTCM1 As String
Dim rstSTCM As ADODB.Recordset, strWorkOrdComp As String, strDate As Date
Dim strFacID As String, sqlSTCM2 As String

If Worksheets("database").Range("B5")  0 Then
    MsgBox "Please Click Transfer to Database Prior to Assigning STCM WO# or Priority", vbOKOnly
    Exit Sub
End If

strWorkOrdComp = Worksheets("database").Range("A5")

'Connection String
MyConn = "c:Team 6 TrackingTeam6TrackingTables.mdb"

'Set Connection to Team 6 Tracking
Set cnSTCM = New ADODB.Connection
cnSTCM.Provider = "Microsoft.Jet.OLEDB.4.0"
cnSTCM.Open MyConn

'Define Variables for Recordset Filters
strDate = Worksheets("database").Range("AK5")
strFacID = Worksheets("WO_Cover").Range("C2")

'Define SQL String for Work Order table and Orignal Invoice table
sqlSTCM1 = "SELECT * FROM tblWorkOrder WHERE FacID = '" & strFacID & "'"
sqlSTCM2 = "SELECT * FROM tblOriginalInvoice WHERE WordOrdComp = '" & strWorkOrdComp & "'"

'Create Recordset Object for Work Order Table and filter to specific record
Set rstSTCM = New ADODB.Recordset
rstSTCM.Open Source:=sqlSTCM1, ActiveConnection:=cnSTCM, CursorType:=adOpenKeyset, LockType:=adLockOptimistic
rstSTCM.Filter = "GenerationDate = #" & strDate & "#"

'Create Recordset Object for Original Invoice Table and filter to specific record
Set rstOrigInv = New ADODB.Recordset
rstOrigInv.Open Source:=sqlSTCM2, ActiveConnection:=cnSTCM, CursorType:=adOpenKeyset, LockType:=adLockOptimistic

For some stinking reason It keeps stopping on the last recordset creation in the code above with a Run-time error '-2147217904 (80040e10)': No value given for one or more required parameters.

If anyone can see any reason why this won't work when the recordset creation immediately before it does not have a problem I am open.

I am hoping someone can help me. I am receiving this run time error when I am trying to open any database on my computer. I have a number of databases, some are on a network. The databases on the network still function from other PCs, even with my network login used. I am able to use the shift key bypass. I have read that this error can be caused if a copy is done when the database or file is open. I did copy a database prior to this happening but it was not open anywhere else. I have deleted the copy thinking it was the source of the problem but I am still receiving the error.
Thanks for your time.

I have a public sub in which I initially empty the table and then enter 3 values in a single record and close. Here's the code.

Dim rstColors As DAO.Recordset

Set rstColors = CurrentDb.OpenRecordset("tblColors", dbOpenDynaset)
strSQL = "DELETE tblColors.* FROM tblColors;"
CurrentDb.Execute strSQL

With rstColors
!Green = lngGreen
!Yellow = lngYellow
!Red = lngRed
End With

Set rstColors = Nothing

It now returns to a form command button event where I want to see the values and produce a message box showing these values. Here's the code.

Set rstColors = CurrentDb.OpenRecordset("tblColors", dbOpenDynaset, dbSeeChanges)

intGreen = rstColors!Green
intYellow = rstColors!Yellow
intRed = rstColors!Red

When I get to intGreen = rstColors!Green, I get run-time error '3167' saying that the record is deleted. When I open the table, I can see the record.

Can anyone help?

Below is a copy of my code. I keep getting a run-time error 2465 "Microsoft Office Access can't find the '|' referred to in your expression" at the portion highlighted in red. What am I doing wrong? Please help me solve this error.

Option Compare Database
Option Explicit

Private Sub cmdExportAutomation_Click()
On Error GoTo err_Handler

MsgBox ExportRequest, vbInformation, "Finished"
Application.FollowHyperlink CurrentProject.Path & "AOSummary.xls"

Exit Sub
MsgBox Err.Description, vbCritical, "Error"
Resume exit_Here
End Sub

Public Function ExportRequest() As String
On Error GoTo err_Handler

Dim dbs As Database
Dim qdf As QueryDef
Dim frm As Form
' Set database variable to current database.
Set dbs = CurrentDb()
Set frm = Forms!AOSummaryReportForm
' Open QueryDef object.
Set qdf = dbs.QueryDefs("AOSummary")
' Set parameters for query based on values entered
' in AOSummaryReportForm.
qdf.Parameters("Forms!AOSummaryReportForm!StartDat e") _
= frm!StartDate
qdf.Parameters("Forms!AOSummaryReportForm!EndDate" ) _
= frm!EndDate

' Excel object variables
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet

Dim sTemplate As String
Dim sTempFile As String
Dim sOutput As String

Dim rst As DAO.Recordset
Dim strSQL As String
Dim lRecords As Long
Dim iRow As Integer
Dim iCol As Integer
Dim iFld As Integer

Const cTabOne As Byte = 1
Const cStartRow As Byte = 2
Const cStartColumn As Byte = 1

DoCmd.Hourglass True

' set to break on all errors
Application.SetOption "Error Trapping", 0

' start with a clean file built from the template file
sTemplate = CurrentProject.Path & "AOSummaryTemplate.xls"
sOutput = CurrentProject.Path & "AOSummary.xls"
If Dir(sOutput) "" Then Kill sOutput
FileCopy sTemplate, sOutput

' Create the Excel Applicaiton, Workbook and Worksheet and Database object
Set appExcel = Excel.Application
Set wbk = appExcel.Workbooks.Open(sOutput)
Set wks = appExcel.Worksheets(cTabOne)
strSQL = "SELECT * FROM AOSummary " & _
"WHERE APPROACH.Date_Field Between #" & [StartDate] & "# AND #" & [EndDate] & "#"

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strSQL, dbOpenSnapshot)

' For this template, the data must be placed on the 4th row, third column.
' (these values are set to constants for easy future modifications)
iCol = cStartColumn
iRow = cStartRow
If Not rst.BOF Then rst.MoveFirst
Do Until rst.EOF
iFld = 0
lRecords = lRecords + 1
Me.lblMsg.Caption = "Exporting record #" & lRecords & " to AOSummary.xls"

For iCol = cStartColumn To cStartColumn + (rst.Fields.Count - 1)
wks.Cells(iRow, iCol) = rst.Fields(iFld)

If InStr(1, rst.Fields(iFld).Name, "Date") > 0 Then
wks.Cells(iRow, iCol).NumberFormat = "mm/dd/yyyy"
End If

wks.Cells(iRow, iCol).WrapText = False
iFld = iFld + 1

iRow = iRow + 1

ExportRequest = "Total of " & lRecords & " rows processed."
Me.lblMsg.Caption = "Total of " & lRecords & " rows processed."

' Cleanup all objects (resume next on errors)
On Error Resume Next
Set wks = Nothing
Set wbk = Nothing
Set appExcel = Nothing
Set rst = Nothing
Set dbs = Nothing
DoCmd.Hourglass False
Exit Function

ExportRequest = Err.Description
Me.lblMsg.Caption = Err.Description
Resume exit_Here

End Function

Hi all!

I have some problems with a search function, or more precise the error-handling of the function.

I’ve added an unbounded textbox (Called search) in the toptext of a continuous form. The form is based on a query which is connected to the unbounded textbox (search).

I’ve written a basic vb function with is activated by the textbox (on change).

	Private Sub search_Change()

        With Me!search
        Dim toSearch As String
        .SelStart = 300
        End With
End Sub

This works well, until there are no more posts to show. Then I get:

Quote: Run-time error ‘2185’ – You can't reference a property or method for a control unless the control has the focus The cause is the .SelStart = 300. Without that line, the Run-time error will not occur. But, the line has to stay..

I’ve tried all the If’s and else’s I know, but could not find a fix. Any ideas?

I've reposted this problem in this forum in hopes to get more feedback.

I have this form that works fine in Access 2007 full version. The form is quite complex but it works. The problem is that when I run it in run-time, I get kicked out. I get "Execution of this application has stopped due to run-time error".


I have a form with many fields called ms1, ms2, ....ms32. On doubleclk ms1, it changes its value by cycling through 3 values "H-Pk", "GBR", and Null. I do this rather than have cbo or list boxes.

Function msCode handles this value change in each of the ms* doubleclicks.

I've tried the suggestions in this forum to find out what the error is,such as cntr-break before the runtime close, but I get closed out and don't see any error number or discription. I've also tried running the runtime on different PCs but get the same each time.

For this example:

-ParamMs = "ms" This is a constant
-Param = "1" - Changes depending on the field
-Field "aa" is used to move the focus off of "ms1" in order to change the value in ms1.

Here is the event for ms1

	Private Sub ms1_DblClick(Cancel As Integer)
On Error GoTo ms1_Err

    Param = "1"
    Call msCode
    Exit Sub
    MsgBox Err.Number & " - " & Err.Description
    Resume ms1_Exit
End Sub

Here is the Function msCode

'   Cycles thru HPack, GBR, Null
Function msCode()

On Error GoTo msCode_err

If IsNull(Me(Me.ParamMs & [Param])) Then
        DoCmd.GoToControl "aa"
        Me(Me.ParamMs & [Param]) = "H-Pk"
        End If
    If Me(Me.ParamMs & [Param]) = "H-Pk" Then
        DoCmd.GoToControl "aa"
        Me(Me.ParamMs & [Param]) = "GBR"
        End If
    If Me(Me.ParamMs & [Param]) = "GBR" Then
        DoCmd.GoToControl "aa"
        Me(Me.ParamMs & [Param]) = Null
        End If

    If Me(Me.ParamMs & [Param]) = "" Then
        DoCmd.GoToControl "aa"
        Me(Me.ParamMs & [Param]) = Null
        End If

    Exit Function
    MsgBox ("error: " & Err.Number & "Desc: " & Err.discription)
    Resume msCode_Exit
End Function

In Access 2007 full version, I get no errors. I'm not sure why this does not work in runtime. I'm open to any suggestions. Thank you.

I am too new to figure this out. (Code was supplied by a member of this forum, thank you for all your help ).
In the code below it errors on one specific line in Red.
The line in Green I added, seems there is/was a missing end if. Best assumption of where the end if should be.

Public Sub transferdata()
'set up connection
    Dim cnn1 As ADODB.Connection
    Set cnn1 = CurrentProject.Connection

    Dim mytbl As AccessObject
    'set up variables to hold the parsed values of the table name holding imported data
    Dim mypart As String
    Dim myrev As String
    Dim myjob As String
    Dim myop As String
    Dim mysn As String
    'set up variable that will hold the position number of the spaces in the table names
    Dim firstspaceposition As Long
    Dim secondspaceposition As Long
    Dim thirdspaceposition As Long
    Dim fourthspaceposition As Long
    Dim fifthspaceposition As Long
    'loop through the table names to find the imported tables; ignore system tables and tables beginning with tbl
    For Each mytbl In CurrentData.AllTables
        If Not Left(mytbl.Name, 4) = "Msys" Then
            If Not Left(mytbl.Name, 3) = "tbl" Then
                'if an imported table is found, parse out the names into their respective variables
                firstspaceposition = InStr(1, mytbl.Name, " ")
                secondspaceposition = InStr(firstspaceposition + 1, mytbl.Name, " ")
                thirdspaceposition = InStr(secondspaceposition + 1, mytbl.Name, " ")
                fourthspaceposition = InStr(thirdspaceposition + 1, mytbl.Name, " ")
                fifthspaceposition = InStr(fourthspaceposition + 1, mytbl.Name, " ")
                mypart = Mid(mytbl.Name, 1, firstspaceposition)
                myrev = Mid(mytbl.Name, firstspaceposition + 1, secondspaceposition - 1 - firstspaceposition + 1)
                myop = Mid(mytbl.Name, secondspaceposition + 1, thirdspaceposition - 1 - secondspaceposition + 1)
                myjob = Mid(mytbl.Name, thirdspaceposition + 1, fourthspaceposition - 1 - thirdspaceposition + 1)
                mysn = Mid(mytbl.Name, fourthspaceposition + 1, fifthspaceposition - 1 - fourthspaceposition + 1)
                'check to see if the job has been previously created if so get pk; if not create new
                If DCount("*", "tblJobs", "txtJobNo='" & myjob & "'") > 0 Then
                    holdJobpk = DLookup("pkJobID", "tblJobs", "txtJobNo='" & myjob & "'")
                    holdPartIDpk = DLookup("pkPartID", "tblParts", "txtPartNo='" & mypart & "'")
                    holdPartRevIDpk = DLookup("pkPartRevID", "tblPartRev", "txtRev='" & myrev & "'")
                    Dim myrecset1 As New ADODB.Recordset
                    myrecset1.ActiveConnection = cnn1
                    myrecset1.Open "tblJobs", , adOpenDynamic, adLockOptimistic
                    With myrecset1
                        !txtJobNo = myjob
                        holdJobpk = !pkJobID
                    End With
                    myrecset1.Open "tblParts", , adOpenDynamic, adLockOptimistic
                    With myrecset1
                        !txtPartNo = mypart
                        holdPartIDpk = !pkPartID
                    End With
                    Set myrecset1 = Nothing
                    myrecset1.Open "tblPartRev", , adOpenDynamic, adLockOptimistic
                    With myrecset1
                        !txtRev = myrev
                    End With
                    Set myrecset1 = Nothing
                End If
            End If
            'reset the variables for the next table
            firstspaceposition = 0
            secondspaceposition = 0
            thirdspaceposition = 0
            fourthspaceposition = 0
            fifthspaceposition = 0
            mypart = ""
            myrev = ""
            myjob = ""
            myop = ""
            mysn = ""
        End If    'added 06.09.09
    Next mytbl

End Sub

The actual error:
Quote: Run-time error '-2147217900(80040e14)'
Invalid SQL Statement; expected 'DELETE', 'INSERT', 'PROCEDURE', 'SELECT', or 'UPDATE'. If I can get past this problem I should be able to make progress with the rest of the data transfer by modifying the code above. Hopefully it will be a good training excersize.

Any hints, tips or examples are appreciated.

Hello I have a felling that this is a rather simple fix but I am very new to VB coding and I have exhausted all that I can think of to fix this error.

This Database refers to keeping track of some Ex-Offender information for my agency. I have a table that contains all the demographic information on the individual; they have a unique ID call a SOID number. This number field has to be typed in manually and cannot be a autonumber. So what I wanted to do is if an employee tries to enter a SOID number of an individual that already exists in the system I want to display a mesg box informing them of the duplicate, delete the duplicate information they entered then transfer them to the existing record with the matching SOID. I know the code worked on another database that I created but that particular one was much simpler and didn't involve relating the SOID number to multiple tables. How do I define which table the 'rsc.FindFirst' statement? Thanks in advance for the help, below is the error mesg that I get and the corresponding code that I am using. The text highlighted in red is what the debug function says there’s something wrong with.

Run-Time error '3079'
The specified field 'SOID_Number' could refer to more than one table listed in the FROM clause of your SQL Statement.

Code: Private Sub SOID_Number_BeforeUpdate(Cancel As Integer) Dim SID As Long Dim stLinkCriteria As String Dim rsc As DAO.Recordset Set rsc = Me.RecordsetClone SID = Me![ExOffender_Info.SOID_Number] stLinkCriteria = "[SOID_Number]=" & SID 'Check Ex Offender Table for duplicate If DCount("ExOffender_Info.SOID_Number", "ExOffender_Info", stLinkCriteria) > 0 Then 'Undo duplicate entry Cancel = True Me.Undo 'Message box warning of duplication MsgBox "WARNING!! the SOID Number " _ & SID & " already exists in the system." _ & vbCr & vbCr & "Your current entry will be deleted and you will be transfered to the matching SOID Number you entered.", _ vbInformation, "Duplicate Information" 'Go to record of original SOID' rsc.FindFirst stLinkCriteria Me.Bookmark = rsc.Bookmark End If Set rsc = Nothing End Sub

I have come across a very odd issue with MS Access run-time. I have developed a piece of code to track the user's login and logout. It works just fine in Developer Access and does not kick out any errors. However, when the identical code is run in Access run-time it kicks out a run-time error, but no error code/description. Are there some libraries that are not recognized by Access run-time? Is there a way to define the correct libraries for run-time using VBA? Any help will be much appreciated.

Code: Private Sub Form_Load() Dim varUserID Dim varLoginTime Dim varLoginDate Dim varDatabase As String Dim varUserCheck Dim varDateCheck Dim varDBCheck varDatabase = "RI" varLoginTime = Time varLoginDate = Date varUserID = Form_FrmMain.RV.Value varDateCheck = DLookup("[LoginDate]", "tblLoginTrack_RI", "[UserID] = '" & varUserID & "'") varDBCheck = DLookup("[DBName]", "tblLoginTrack_RI", "[UserID] = '" & varUserID & "'") varUserCheck = DLookup("[UserID]", "tblLoginTrack_RI", "[UserID] = '" & varUserID & "'") If IsNull(varUserCheck) Then mySQL = "INSERT INTO tblLoginTrack_RI (UserID, LoginTime, LoginDate, DBName) VALUES ('" & varUserID & "', #" & varLoginTime & "#, #" & varLoginDate & "#, '" & varDatabase & "')" CurrentDb.Execute mySQL, dbFailOnError End If If varUserCheck "" Then If varDateCheck = Date Then If varDBCheck = varDatabase Then mySQL = "DELETE * FROM tblLoginTrack_RI WHERE UserID='" & varUserID & "' AND DBName='" & varDatabase & "' AND LoginDate = #" & varLoginDate & "#" CurrentDb.Execute mySQL, dbFailOnError mySQL = "INSERT INTO tblLoginTrack_RI (UserID, LoginTime, LoginDate, DBName) VALUES ('" & varUserID & "', #" & varLoginTime & "#, #" & varLoginDate & "#, '" & varDatabase & "')" CurrentDb.Execute mySQL, dbFailOnError End If End If If varDateCheck Date Then mySQL = "INSERT INTO tblLoginTrack_RI (UserID, LoginTime, LoginDate, DBName) VALUES ('" & varUserID & "', #" & varLoginTime & "#, #" & varLoginDate & "#, '" & varDatabase & "')" CurrentDb.Execute mySQL, dbFailOnError End If End If End Sub Code: Private Sub Form_Close() Dim varUserID Dim varExitTime Dim varLoginDate Dim varDatabase As String varDatabase = "RI" varExitTime = Time varLoginDate = Date varUserID = Form_FrmMain.RV.Value mySQL = "Update tblLoginTrack_RI SET ExitTime=#" & varExitTime & "# WHERE UserID='" & varUserID & "' AND DBName='" & varDatabase & "' AND LoginDate = #" & varLoginDate & "#" CurrentDb.Execute mySQL, dbFailOnError End Sub

Quote: Set db = CurrentDb
Set td = db.QueryDefs("BrandErrorsCrosstab")
For i = 1 To td.Fields.Count - 4
iNum = Trim(Str(i))
Me("Brand" & iNum).ControlSource = td.Fields(i + 3).Name
Me("Head" & iNum).Caption = td.Fields(i + 3).Name
Me("Sum" & iNum).ControlSource = "=Sum([" & td.Fields(i + 3).Name & "])"
Me("Brand" & iNum).Visible = True
Me("Head" & iNum).Visible = True
Me("Sum" & iNum).Visible = True
Next i
If Not Locate() > 0 Then
Location.Visible = False
End If
End Sub

Run-time error 2465, can't find 'Brand12' in Report_ESBB: class module

I've been running this database for 2 years with no problem. My knowledge with Access is limited, as I'm into MySQL and Php. This program was programmed by programmer who was fired, and he had the recent source files deleted and older sources locked. Can anyone clue me in as to how I can try and to redemy this problem?

I have a simple form with a reset, a submit query and a close button. If I click the reset button and then try to run a qery I get an error message that says 'Run Time Error '2001': you canceled the last operation'. What does this mean and how can I get rid of it?. Here is my code....

Private Sub CloseButton_Click()
End Sub

Private Sub ResetButton_Click()
[bemDescription] = ""
[bemQueue] = ""
[bemPriority] = ""
[bemStatus] = ""
[bemEntity] = ""
[bemCptyID] = ""
[bemCptyType] = ""
[bemValueDateFrom] = ""
[bemValueDateTo] = ""
[bemCreationDateFrom] = ""
[bemCreationDateTo] = ""

End Sub

Private Sub QueryButton_Click()
Me.Visible = False
DoCmd.OpenQuery "bemExceptionsQuery", acViewNormal, acReadOnly
End Sub

This is the sql query:

WHERE (((BEM_EXCEPTIONS.BEM_EXCEPTION_DESC)=Forms!frmBem Exceptions!bemDescription OR ISNULL(Forms!frmBemExceptions!bemDescription)) And ((BEM_EXCEPTIONS.BEM_GROUP_ID)=Forms!frmBemExcepti ons!bemQueue Or ISNULL(Forms!frmBemExceptions!bemQueue)) And ((BEM_EXCEPTIONS.BEM_PRIORITY)=Forms!frmBemExcepti ons!bemPriority Or ISNULL(Forms!frmBemExceptions!bemPriority)) And ((BEM_EXCEPTIONS.BEM_STATUS)=Forms!frmBemException s!bemStatus Or ISNULL(Forms!frmBemExceptions!bemStatus)) And ((BEM_EXCEPTIONS.BEM_ENTITY)=Forms!frmBemException s!bemEntity Or ISNULL(Forms!frmBemExceptions!bemEntity)) And ((BEM_EXCEPTIONS.BEM_CPTY_ID)=Forms!frmBemExceptio ns!bemCptyID Or ISNULL(Forms!frmBemExceptions!bemCptyID)) And ((BEM_EXCEPTIONS.BEM_CPTY_TYPE)=Forms!frmBemExcept ions!bemCptyType Or ISNULL(Forms!frmBemExceptions!bemCptyType)) And ((BEM_EXCEPTIONS.BEM_VALUE_DATE) Between Forms!frmBemExceptions!bemValueDateFrom And Forms!frmBemExceptions!bemValueDateTo Or ISNULL(Forms!frmBemExceptions!bemValueDateFrom)) And ((BEM_EXCEPTIONS.BEM_DATE_TIME_CREATION) Between Forms!frmBemExceptions!bemCreationDateFrom And Forms!frmBemExceptions!bemCreationDateTo Or ISNULL(Forms!frmBemExceptions!bemCreationDateFrom) ));

Please help me, I have hit a massive wall again.
I am writing an estimation program and am having a
run-time error 438 (Object does not support this property or Method).
On the estimation form is a command button whose on click event holds
the command to open the Report
DoCmd.OpenReport "Rpt_Estimate", acViewNormal, , , , "DISP_ID"
The recordsource of the report is a table
And on the "On format event" of the detail section which is made up of text
boxes I am trying to print blanks when there are no more records by making
the forecolor of the Text boxes white but get the run-time error on the
first line below

Me!PartName.ForeColor = vbWhite ' Error on this line

Me!DrawingNo.ForeColor = vbWhite

Me!SIZE.ForeColor = vbWhite
Me!Qty.ForeColor = vbWhite
Me!Price.ForeColor = vbWhite
Me!Amount.ForeColor = vbWhite
Me!Miscellanous.ForeColor = vbWhite
I have looked thorougly but can't figure out what the problem is.
I don't think it matters but it should be noted the field names and
name of the Text boxes are the same.

I keep getting an error:

run-time error '2185'
"you can't reference a property or method for a control unless the control
has the focus."

There is no problem with CheckFilter function, I checked.

My Code:

Quote: Private Sub Building_AfterUpdate()
Call CheckFilter

Dim sBuildingRoom As String
sBuildingRoom = "SELECT DISTINCT Location.[Location ID],Location.Room " & _
"FROM Building INNER JOIN Location ON Building.[Building ID]=Location.[Building ID]" & _
"WHERE Building.[Building Name]= '" & Me.Building.Text & "'" & _
"ORDER by Location.Room"
Me.Location.RowSource = sBuildingRoom

End Sub Thanks

I have managed to write some vb to write data from one table to another. However, it seems to stop with a message (Run time error ’94’ Invalid use of Null).

This specifically occurs at the point

strVariable= ![Field]

Is there away I can put a statement in to avoid the nulls. If I use an if statement in the form…

If Field=null then…. It doesn’t seem to work and carries over the value anyway.

Any suggestions please.

Well, its a new week and we have new mysteries. For me, the mystery is why my code below keeps giving me the error "Run-time error '3265': Item not found in the collection." Please note that the debug shows me that the error occurs on the specific lines are where I'm replacing [[Grp]] and [[Type]] with their related values in my query. I looked up the 3265 error and, in general, it means that the referenced object is not part of the called query. The mystery is that those two columns ARE in the query. If I take out those two lines, the code runs perfectly. I've checked and rechecked the column names in the query. I've double checked the text file to make sure there are no typo's there. I just can't see where the error is... Any suggestions?

	Public Function SendEMail()

Dim db As DAO.Database
Dim MailList As DAO.Recordset
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim Subjectline As String
Dim BodyFile As String
Dim fso As FileSystemObject
Dim MyBody As TextStream
Dim MyBodyText As String
Dim MyNewBodyText As String
Dim newPath As DAO.Recordset
Dim strPath As String
Dim strFileName As String
Set db = CurrentDb()
Set newPath = db.OpenRecordset("Set_Path")
strFileName = "Mail Merge - Mail Test.txt"
strPath = newPath!path & strFileName
Set fso = New FileSystemObject
Subjectline$ = "Daily Status"

If Subjectline$ = "" Then
MsgBox "No subject line, no message." & vbNewLine & vbNewLine & _
"Quitting...", vbCritical, "E-Mail Merger"
Exit Function
End If

BodyFile$ = strPath

If BodyFile$ = "" Then
MsgBox "No body, no message." & vbNewLine & vbNewLine & _
"Quitting...", vbCritical, "I Ain’t Got No-Body!"
Exit Function
End If

If fso.FileExists(BodyFile$) = False Then
MsgBox "The body file isn’t where you say it is. " & vbNewLine & vbNewLine & _
"Quitting...", vbCritical, "I Ain’t Got No-Body!"
Exit Function
End If

Set MyBody = fso.OpenTextFile(BodyFile, ForReading, False, TristateUseDefault)

MyBodyText = MyBody.ReadAll

Set MyOutlook = New Outlook.Application

Set db = CurrentDb()

Set MailList = db.OpenRecordset("MyEmailAddresses")

Do Until MailList.EOF

MyNewBodyText = MyBodyText
MyNewBodyText = Replace(MyNewBodyText, "[[Name]]", MailList("Name"))
MyNewBodyText = Replace(MyNewBodyText, "[[Status]]", MailList("Status"))
MyNewBodyText = Replace(MyNewBodyText, "[[End]]", MailList("Timecard Stop Date"))
MyNewBodyText = Replace(MyNewBodyText, "[[Dpt]]", MailList("Dept"))
MyNewBodyText = Replace(MyNewBodyText, "[[Title]]", MailList("Title Rank"))
MyNewBodyText = Replace(MyNewBodyText, "[[Name2]]", MailList("Name"))
MyNewBodyText = Replace(MyNewBodyText, "[[Grp]]", MailList("People Group"))
MyNewBodyText = Replace(MyNewBodyText, "[[Appv]]", MailList("Time Approver"))
MyNewBodyText = Replace(MyNewBodyText, "[[Type]]", MailList("Person Type"))
MyNewBodyText = Replace(MyNewBodyText, "[[Late]]", MailList("DaysLate"))

Set MyMail = MyOutlook.CreateItem(olMailItem)
MyMail.To = MailList("email")
MyMail.Subject = Subjectline$
MyMail.Body = MyNewBodyText



Set MyMail = Nothing
Set MyOutlook = Nothing

Set MailList = Nothing
Set db = Nothing

End Function

Not finding an answer? Try a Google search.