I have been struggling with getting this code to work for a few days. If you could offer any solutions I would really appreciate it.
Private Sub Command0_Click()
If IsNull(NewSupBox.Value) Or IsNull(NewNumberBox.Value) Then
MsgBox ("All fields must be filled")
GoTo ErrorExit
End If
If Not IsNull(DLookup("SupplierNumber", "SupGenInfo ", "SupGenInfo.SupplierNumber =" & NewSupBox)) = Then
MsgBox ("This supplier number already exists. You can edit the current record on the Edit supplier page.")
GoTo ErrorExit
End If
Dim db As Database
Dim rec As Recordset
Set db = CurrentDb
Set rec = db.OpenRecordset("select * from SupGenInfo")
rec.AddNew
rec("SupplierNumber") = Me.NewSupBox.Value
rec("SupplierName") = Me.NewNameBox.Value
rec.Update
Set rec = Nothing
Set db = Nothing
MsgBox "Records added successfully."
ErrorExit:
End Sub
Edit: Forgot to mention that I am not getting any error message. The command will simply not add a new record to my table.
Edit2: The code above will output the msg "Records Added Successfully" when i remove the following block of code.
Dim db As Database
Dim rec As Recordset
Set db = CurrentDb
Set rec = db.OpenRecordset("SupGenInfo")
rec.AddNew
rec("SupplierNumber") = Me.NewSupBox
rec("SupplierName") = Me.NewNameBox
rec.Update
Set rec = Nothing
Set db = Nothing
It is when this code is included that my command click becomes unresponsive.
I believe, you are reading a table (for display purposes) with your select * ... statement, then you're adding a new record to that list rather than the actual database. When you open OpenRecordset, just supply the table name, not a whole SQL query shebang...
I created a new table, so edit this code to match your parameters/values, otherwise this has been tested to work:
Dim db As Database
Dim rec As Recordset
Set db = CurrentDb
Set rec = db.OpenRecordset("Table1")
rec.AddNew
rec("Field1") = 1234
rec("Field2") = "blah2"
rec("Field3") = "blah3"
rec.Update
Set rec = Nothing
Set db = Nothing
Hope this helps.
Related
I'm creating a form that is intended to add records to a data table or edit existing record if the ID is a duplicate. `
UPDATE**
I've figured out how to make this work. Sort of. My current code is
`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`
This adds or edits records. However, after adding a record and trying to close my form I get an error message about how the table can't be saved because it created a duplicate. When I click through all the error messages re-open the table, the records are still on there anyway. I can't seem to figure out how to get around this.Error Image
I'm VERY new to VBA but have some coding experience so I'm slowly starting to learn. I have two tables in my access database that each have one field that is the same. One table is a distinct list of the possible values ("TOSITEXREF")that could show up in the same field on the other table ("Trans_Earned"). This function I am trying to create will run in a macro to figure out whether or not the data that is being appended via queries has an instance in the ToLocn field that is not on the list of possible values. Here is what I have so far, but is not working:
Function TESTING()
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("TransEarned")
Dim rs2 As DAO.Recordset
Set rs2 = CurrentDb.OpenRecordset("TOSITEXREF")
Dim cond1A As Boolean
cond1A = (rs.Fields("ToLocn") = rs2.Fields("ToLoc"))
If cond1A Then
DoCmd.OpenQuery "Earns", acViewNormal, acEdit
Else
DoCmd.CancelEvent
MsgBox "Unknown ToLocation, Please Update TOSITEXREF File to acccount for new location", vbOKOnly, "NEW LOCATION"
End If
Set rs = Nothing
Set rs2 = Nothing
End Function
Final VBA example that will return a value in the Loc field from table1 that does not show up in the Loc field of Table2:
Function Validate()
Dim sql As String
Dim rs As DAO.Recordset
sql = "SELECT Table1.Loc FROM Table1 LEFT JOIN Table2 ON Table1.Loc = Table2.Loc WHERE (((Table2.Loc) Is Null))"
Set rs = CurrentDb.OpenRecordset(sql)
If (rs.RecordCount = 0) Then
MsgBox "WORKS", vbkokonly, "WORKS"
Else
MsgBox "DOES NOT WORK", vbkokonly, "DOES NOT WORK"
Set rs = Nothing
End If
End Function
I have an Access 2010 database that was local and I have since linked to a SQL 2012 database. However, I have a form to insert a highlight record that runs the below code:
Private Sub Command18_Click()
Dim R As Recordset
Set R = CurrentDb.OpenRecordset("SELECT * FROM [tblJobHead]")
R.AddNew
R![Rep Num] = [Forms]![frmMain]![NavigationSubform].[Form]![RepNum]
R![Item Number] = Me.ItemNumber.Value
R![Description] = Me.Desc.Value
R![EmpID] = [TempVars]![EmpID]
R![Status] = 2
R.Update
R.Close
Set R = Nothing
DoCmd.Save
End Sub
However, when I click the button I now receive the error:
Error 3622 - You must use the dbSeeChanges option with OpenRecordset when accessing a SQL Server table that has an IDENTITY column
Any ideas?
Regards,
Michael
The error is exactly as it says, try:
Function GetRecordset(sSQL) As DAO.Recordset
Dim rdao As DAO.Recordset
Dim db As Database
Set db = CurrentDb
Set rdao = db.OpenRecordset(sSQL, dbOpenDynaset, _
dbFailOnError + dbSeeChanges)
If Not rdao.EOF Then
rdao.MoveLast
rdao.MoveFirst
End If
Set GetRecordset = rdao
End Function
I would strongly advise you to avoid single letters as variables.
I am trying to output the name of all linked tables, including their fields which are Date/Time, and that fields values.
The following code can output the first table, field name and their first value, not all values, although when it gets to the next linked table, I get this error
Run-time Error '3622'
You must use the dbSeeChanges option with OpenRecordSet when accessing a SQL Server table that has an IDENTITY column.
Here is my code
Private Sub btnGetFields_Click()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim f As Field
Dim rst As DAO.Recordset
Dim numField As Integer
Set db = CurrentDb
For Each tdf In db.TableDefs
If Left$(tdf.Connect, 9) = "ODBC;DSN=" Then
Set rst = CurrentDb.OpenRecordset(tdf.Name)
numField = rst.Fields.Count
Debug.Print "Table: " & tdf.Name
For index = 0 To numField - 1
If rst.Fields(index).Type = dbDate Then
Debug.Print "Field: " & rst.Fields(index).Name; " Value : "; rst.Fields(index).Value
End If
Next
End If
Next
Set tdf = Nothing
Set db = Nothing
End Sub
I read something that if I'm using sql tables I should use ADO?
Any ideas?
You can continue to use your existing DAO code, just change
Set rst = CurrentDb.OpenRecordset(tdf.Name)
to
Set rst = CurrentDb.OpenRecordset(tdf.Name, dbOpenSnapshot)
That opens a static read-only Recordset, so dbSeeChanges is not required.
Hi Maybe someone can enlighten me here. Using VBA code and I want to include a check for zero record count from a query and it now fails at the code I added where it was fine before. Code below shows set up:
Sub MySub()
Dim db As DAO.Database
Set db = CurrentDb()
Dim qdf As DAO.QueryDef
Dim sqlQry As String
Dim rst As DAO.Recordset
sqlQry = "My Query String"
If DLookup("Name", "MSysObjects", "Name= 'QueryName1'") <> "" Then
Set qdf = CurrentDb.QueryDefs("QueryName1")
qdf.SQL = sqlQry
Else
Set qdf = CurrentDb.CreateQueryDef("QueryName1", sqlQry)
End If
Set rst = db.OpenRecordset(qdf.Name) << FAILS HERE
If rst.RecordCount <> 0 Then
DoCmd.OpenQuery (qdf.Name)
Else
MsgBox "no data returned"
Exit Sub
End If
Set qdf = Nothing
Set db = Nothing
End Sub
It fails on the line shown above with run "time error 3219 Invalid Operation". the only thing I changed is added an object reference for business objects for another part of the code, not this part. It ran fine before and only other change is start of a new sub below this code but running only this bit code (not the whole module) in debug mode it came up with the error.