Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations IamaSherpa on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Add new record only if not existing

Status
Not open for further replies.
thomasks

thomasks

Programmer
May 12, 2006
113
US
I have some VBA code that takes field values from an excel worksheet and dumps them into a table in Access. I need to check if the record in the table exists first, and if it does than only update it. If it does not then add a new record. Here is the code I have so far.
Code: 
Sub UpdateMasterDb()
    Dim cn As ADODB.Connection, rs As ADODB.Recordset
    Dim intResale As Integer
    Dim intHours As Integer
    
    On Error Resume Next
    intHours = Worksheets("Project pricing summary").Range("G60").Value + Worksheets("Project pricing summary").Range("G61").Value _
    + Worksheets("Project pricing summary").Range("G62").Value
    intResale = Worksheets("Project information").Range("D26").Value + Worksheets("Project information").Range("D28").Value
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
    "Data Source=T:\Quot\CONTROLS\Formulas\Estworksheet\Master Quote List\Controls Estimating Database.mdb;"
    Set rs = New ADODB.Recordset
    rs.Open "Tbl_Controls_Quote_Master", cn, adOpenKeyset, adLockOptimistic, adCmdTable
    rs.AddNew
    rs.Fields("Project") = Worksheets("Project information").Range("L6").Value
    rs.Fields("Customer") = Worksheets("Project information").Range("D6").Value
    rs.Fields("Location") = Worksheets("Project information").Range("D7").Value
    rs.Fields("Quote_Type") = Worksheets("Project information").Range("L7").Value
    rs.Fields("Estimator") = Worksheets("Project information").Range("D8").Value
    rs.Fields("Date_Quoted") = Worksheets("Project information").Range("L5").Value
    rs.Fields("Comments_Scope") = Worksheets("Project pricing summary").Range("C15").Value
    rs.Fields("File_Path_Hyperlink") = Application.ActiveWorkbook.Name & "#" & Application.ActiveWorkbook.FullName & "#"
    rs.Fields("Resale") = intResale
    rs.Fields("Hardware") = Worksheets("Project information").Range("D27").Value
    rs.Fields("Eng_Hours") = intHours
    rs.Fields("Travel") = Worksheets("Project pricing summary").Range("L59").Value
    rs.Update
'    If Err = -2147217887 Then
'        MsgBox ("Unable to update database, record already exists!")
'    Else
'        MsgBox ("Database has been updated")
'    End If
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    Worksheets("Project information").Range("B1").Value = "True"
End Sub
Thanks in advance for any help.

KT
 
Sort by date Sort by votes
How about:

Code: 
rs.Open "SELECT * FROM Tbl_Controls_Quote_Master " _ 
& " WHERE Project ='" & Worksheets("Project information").Range("L6").Value _
& "'", cn, adOpenKeyset, adLockOptimistic, adCmdTable

If rs.EOF Then
  'Doesn't exist
Else
  'Exists
End If

Or such like?
 
Upvote 0 Downvote
You could use the DLOOKUP function in your If Statement...

Something like this:
Code: 
Private Sub CheckIfExists()
  Dim strMyValue As String
  strMyValue = "Howdy123"
  If DLookup("[FieldName]","[TableName]","[FieldName] ='" & _
     Forms![MyForm]!MyFormControl & "'") Then
    MsgBox "Record Exists!", vbInformation,"Record Exists!"
  Else
    MsgBox "Record ain't here.", vbInformation, "Not here."
  End If
End Sub

Anyway, put in your table/field names and form/control names, and you might can test like that - may need to clean up the syntax a little, I didn't test.

Also, look at the helpfile for DLOOKUP in Access VBA, as there are some good examples there as well.

--

"If to err is human, then I must be some kind of human!" -Me
 
Upvote 0 Downvote
Thanks guys,
I tried this:
Code: 
Sub UpdateMasterDb()
    Dim cn As ADODB.Connection, rs As ADODB.Recordset
    Dim intResale As Integer
    Dim intHours As Integer
    
'    On Error Resume Next
    intHours = Worksheets("Project pricing summary").Range("G60").Value + Worksheets("Project pricing summary").Range("G61").Value _
    + Worksheets("Project pricing summary").Range("G62").Value
    intResale = Worksheets("Project information").Range("D26").Value + Worksheets("Project information").Range("D28").Value
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
    "Data Source=T:\Quot\CONTROLS\Formulas\Estworksheet\Master Quote List\Controls Estimating Database.mdb;"
    Set rs = New ADODB.Recordset

[b]  
    rs.Open "SELECT Tbl_Controls_Quote_Master.*, Tbl_Controls_Quote_Master.Project" _
    & " FROM Tbl_Controls_Quote_Master WHERE Tbl_Controls_Quote_Master.Project = '" _
    & Worksheets("Project information").Range("L6").Value _
    & "'", cn, adOpenKeyset, adLockOptimistic, adCmdTable
[/b]

        If rs.EOF Then
            rs.AddNew 'Doesn't exist
            rs.Fields("Project") = Worksheets("Project information").Range("L6").Value
            rs.Fields("Customer") = Worksheets("Project information").Range("D6").Value
            rs.Fields("Location") = Worksheets("Project information").Range("D7").Value
            rs.Fields("Quote_Type") = Worksheets("Project information").Range("L7").Value
            rs.Fields("Estimator") = Worksheets("Project information").Range("D8").Value
            rs.Fields("Date_Quoted") = Worksheets("Project information").Range("L5").Value
            rs.Fields("Comments_Scope") = Worksheets("Project pricing summary").Range("C15").Value
            rs.Fields("File_Path_Hyperlink") = Application.ActiveWorkbook.Name & "#" & Application.ActiveWorkbook.FullName & "#"
            rs.Fields("Resale") = intResale
            rs.Fields("Hardware") = Worksheets("Project information").Range("D27").Value
            rs.Fields("Eng_Hours") = intHours
            rs.Fields("Travel") = Worksheets("Project pricing summary").Range("L59").Value

        Else
            rs.Update 'Exists
            rs.Fields("Project") = Worksheets("Project information").Range("L6").Value
            rs.Fields("Customer") = Worksheets("Project information").Range("D6").Value
            rs.Fields("Location") = Worksheets("Project information").Range("D7").Value
            rs.Fields("Quote_Type") = Worksheets("Project information").Range("L7").Value
            rs.Fields("Estimator") = Worksheets("Project information").Range("D8").Value
            rs.Fields("Date_Quoted") = Worksheets("Project information").Range("L5").Value
            rs.Fields("Comments_Scope") = Worksheets("Project pricing summary").Range("C15").Value
            rs.Fields("File_Path_Hyperlink") = Application.ActiveWorkbook.Name & "#" & Application.ActiveWorkbook.FullName & "#"
            rs.Fields("Resale") = intResale
            rs.Fields("Hardware") = Worksheets("Project information").Range("D27").Value
            rs.Fields("Eng_Hours") = intHours
            rs.Fields("Travel") = Worksheets("Project pricing summary").Range("L59").Value


        End If
        
'    rs.Open "Tbl_Controls_Quote_Master", cn, adOpenKeyset, adLockOptimistic, adCmdTable
'    rs.AddNew
'    rs.Fields("Project") = Worksheets("Project information").Range("L6").Value
'    rs.Fields("Customer") = Worksheets("Project information").Range("D6").Value
'    rs.Fields("Location") = Worksheets("Project information").Range("D7").Value
'    rs.Fields("Quote_Type") = Worksheets("Project information").Range("L7").Value
'    rs.Fields("Estimator") = Worksheets("Project information").Range("D8").Value
'    rs.Fields("Date_Quoted") = Worksheets("Project information").Range("L5").Value
'    rs.Fields("Comments_Scope") = Worksheets("Project pricing summary").Range("C15").Value
'    rs.Fields("File_Path_Hyperlink") = Application.ActiveWorkbook.Name & "#" & Application.ActiveWorkbook.FullName & "#"
'    rs.Fields("Resale") = intResale
'    rs.Fields("Hardware") = Worksheets("Project information").Range("D27").Value
'    rs.Fields("Eng_Hours") = intHours
'    rs.Fields("Travel") = Worksheets("Project pricing summary").Range("L59").Value
'    rs.Update
'    If Err = -2147217887 Then
'        MsgBox ("Unable to update database, record already exists!")
'    Else
'        MsgBox ("Database has been updated")
'    End If
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    Worksheets("Project information").Range("B1").Value = "True"
End Sub
But I am getting an error ("Syntax error in FROM clause") and can't seem to find it... grrrrrr


 
Upvote 0 Downvote
Split the string out, it should help in spotting the error in that you can debug.print the sql string and test it in the query window, if necessary:

Code: 
strSQL= "SELECT Tbl_Controls_Quote_Master.* "
    & " FROM Tbl_Controls_Quote_Master WHERE Tbl_Controls_Quote_Master.Project = '" _
    & Worksheets("Project information").Range("L6").Value _
    & "'"

rs.Open strSQL, cn, adOpenKeyset, adLockOptimistic, adCmdTable

You had one field in twice, (* and field name). Is Project a text field? If not skip the single quotes.
 
Upvote 0 Downvote
Yes project is a text field.
The sql string works fine if I put it in the query design window in sql view (from the debug.print). it's when it gets to the rs.open that I get an error.
 
Upvote 0 Downvote
One possible note:
Code: 
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset

Should probably be put as this:
Code: 
    Dim cn As ADODB.Connection: rs As ADODB.Recordset

Or this:
Code: 
    Dim cn As ADODB.Connection, rs As ADODB.Recordset

..I think... I seem to remember a thread here talking about how that using the comma really does not do what you would think in separating variables on the same line...

With the colon, I don't recall at the moment whether or not you need Dim the second time.

--

"If to err is human, then I must be some kind of human!" -Me
 
Upvote 0 Downvote
Oops:

rs.Open strSQL, cn, adOpenKeyset, adLockOptimistic, [red]adCmdTable[/red]

Try:
rs.Open strSQL, cn, adOpenKeyset, adLockOptimistic
 
Upvote 0 Downvote
Thanks Remou,
Now the connection is opening fine. But.... I get an "Operation is not allowed in this context" error when I hit the rs.close line in my code. Do you know what causes this? When I try to go the the help file (F1) I get a blank screen.
 
Upvote 0 Downvote
Ok, I got it. I have to have the line:
rs.update
just before rs.close.... duh...
Thanks for all the help guys :)
 
Upvote 0 Downvote
Perhaps:

Code: 
If rs.EOF Then
            rs.AddNew 'Doesn't exist
            <...>
        Else
            'rs.Update 'Exists
            <...>
        End If
        
        rs.Update
        rs.Close
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

V
  • Locked
  • Helpful tip
Capture Shift Key if Pressed on A form
Replies
3
Views
320
strongm
strongm
Kennelbloke
  • Locked
  • Solved
Refer to Navigation Control Subform Record
Replies
8
Views
659
Kennelbloke
Kennelbloke
Moss100
  • Locked
  • Question
Open filtered for and set cursor at particular record
Replies
1
Views
327
Moss100
Moss100
Moss100
  • Locked
  • Question
Vba adding record to table when field is integer
Replies
8
Views
346
Moss100
Moss100
renigar
  • Locked
  • Question
Code to write file path to field always writes to 1st record 1
Replies
5
Views
415
dhookom
dhookom

Part and Inventory Search

Sponsor

Back
Top