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:

	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
        .AddNew
        .Fields(1).Value = strDate
        .Fields(2).Value = strUsername
        .Update '        


Sponsored Links:



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 support.microsoft.com, 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.

Thanks!


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.AddNew
rstEmpSkill.Fields("intEmployeeID") = Me.lstEmps.ItemData(varItem)
rstEmpSkill.Fields("intSkillID") = Me.lstTasks.ItemData(varItem2)
rstEmpSkill.Update
End If
skipdups:
Next varItem2
Next varItem
MsgBox "Your selections have been processed..."




Hi

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...


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

Thanks for help

flofi




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.




Hello,

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
.AddNew
!MyField1 = Forms!MyForm!MyField1
!MyField2 = rs1!MyField2
.Update
End With
rs1.MoveNext
Loop

Forms!MyForm!MySubForm1.Requery
Forms!MyForm!MySubForm2.Requery
Forms!MyForm!MySubForm3.Requery

rs1.Close
rs2.Close
db.Close

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
Workdate.SetFocus
Else
Response = acDataErrDisplay
End If

End Sub

Anyone who knows how to solve this problem?

Thanks already.

Pascal




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
Else
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 -

	Code:
	Call UpdatePerformanceAdd(StewID.Value, StartDate.Value)

The module is as follows -

	Code:
	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
            .AddNew
            !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
        Wend
    End With
    rstFuture.Close
    rstPerf.Close
    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.


	Code:
	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 '*'"
    Else
        StrCommercial = "='" & Me.Cbocommercial.Value & "'"
    End If
    
    
'Build Criteria string for Customer
    If IsNull(Me.CboCustomer.Value) Then
        StrCustomer = "Like '*'"
    Else
        StrCustomer = "='" & Me.CboCustomer.Value & "'"
    End If
    
'Build criteria for Date due for Beginning Date
    If IsNull(Me.txtbegdate.Value) Then
        Date_Due = "Like '*'"
    Else
        Date_Due = "='" & Me.txtbegdate.Value & "'"
    End If
    
'Build criteria for Date due for End Date
    If IsNull(Me.txtenddate.Value) Then
        Date_Due = "Like '*'"
    Else
        Date_Due = "='" & Me.txtenddate.Value & "'"
    End If
    

'Build Criteria string for Status
    If IsNull(Me.CboStatus.Value) Then
       StrStatus = "Like '*'"
    Else
        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

Michelle




Here is the code I am using:

	Code:
	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
Else
    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
.AddNew
!Green = lngGreen
!Yellow = lngYellow
!Red = lngRed
.Update
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_Here:
Exit Sub
err_Handler:
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"
Me.Repaint

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
Next

wks.Rows(iRow).EntireRow.AutoFit
iRow = iRow + 1
rst.MoveNext
Loop

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

exit_Here:
' 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

err_Handler:
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).


	Code:
	Private Sub search_Change()

    Me.Requery
    
        With Me!search
        Dim toSearch As String
        .SetFocus
        .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".

Background:

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


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

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


Here is the Function msCode


	Code:
	'-----------------------------------------------
'   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
        End If
    If Me(Me.ParamMs & [Param]) = "H-Pk" Then
        DoCmd.GoToControl "aa"
        Me(Me.ParamMs & [Param]) = "GBR"
        End
        End If
    If Me(Me.ParamMs & [Param]) = "GBR" Then
        DoCmd.GoToControl "aa"
        Me(Me.ParamMs & [Param]) = Null
        End
        End If

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

msCode_Exit:
    Exit Function
    
msCode_Err:
    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.


	Code:
	 
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 & "'")
                Else
                    Dim myrecset1 As New ADODB.Recordset
                    myrecset1.ActiveConnection = cnn1
                    myrecset1.Open "tblJobs", , adOpenDynamic, adLockOptimistic
                    With myrecset1
                        .AddNew
                        !txtJobNo = myjob
                        holdJobpk = !pkJobID
                        .Update
                        .Close
                    End With
                                        
                    myrecset1.Open "tblParts", , adOpenDynamic, adLockOptimistic
                    With myrecset1
                        .AddNew
                        !txtPartNo = mypart
                        holdPartIDpk = !pkPartID
                        .Update
                        .Close
                    End With
                    Set myrecset1 = Nothing
                    
                    myrecset1.Open "tblPartRev", , adOpenDynamic, adLockOptimistic
                    With myrecset1
                        .AddNew
                        
                        !txtRev = myrev
                        
                        .Update
                        .Close
                    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
td.Close
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?