Add New Records With VBA

[Pricey]

Hi

I am new to this forum and quite new to vba so if someone could help me with this code it would be appreicated.

What the code does is add's a new record to a table using the information it gets from a form and that works fine.

Below the first code is what I am trying to do.



Dim rs As ADODB.Recordset
On Error GoTo HandleError
Set rs = New ADODB.Recordset
rs.Open "tblRegister", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
With rs
![IDNHHMeter] = Me.txtIDNHHMeter
![Register] = Me.txtRegister
.Update
End With
rs.Close
Set rs = Nothing

ExitHere:
Exit Sub
HandleError:
MsgBox Err.Description
Resume ExitHere


What I would like to do is put a loop on this code so I can add multiple records depending on what number is in the text box txtRegister. In each record the IDNHHMeter would stay the same but the register would start at 1 and have an increment of 1 until it gets to the number in txtRegister. Below is my code which doesnt seem to work. Any ideas?

Dim R As Integer
Dim i As Integer

Do

For i = 1 To R
Dim rs As ADODB.Recordset
On Error GoTo HandleError
Set rs = New ADODB.Recordset
rs.Open "tblRegister", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
With rs
![IDNHHMeter] = Me.txtIDNHHMeter
![Register] = i
.Update
End With
rs.Close
Set rs = Nothing
Exit For
Next

Loop Until i = R

ExitHere:
Exit Sub
HandleError:
MsgBox Err.Description
Resume ExitHere

End Sub

 

[jdraw]

Hi

I am new to this forum and quite new to vba so if someone could help me with this code it would be appreicated.

What the code does is add's a new record to a table using the information it gets from a form and that works fine.

Below the first code is what I am trying to do.



Dim rs As ADODB.Recordset
On Error GoTo HandleError
Set rs = New ADODB.Recordset
rs.Open "tblRegister", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
With rs
![IDNHHMeter] = Me.txtIDNHHMeter
![Register] = Me.txtRegister
.Update
End With
rs.Close
Set rs = Nothing

ExitHere:
Exit Sub
HandleError:
MsgBox Err.Description
Resume ExitHere


What I would like to do is put a loop on this code so I can add multiple records depending on what number is in the text box txtRegister. In each record the IDNHHMeter would stay the same but the register would start at 1 and have an increment of 1 until it gets to the number in txtRegister. Below is my code which doesnt seem to work. Any ideas?

Dim R As Integer
Dim i As Integer

Do

For i = 1 To R
Dim rs As ADODB.Recordset
On Error GoTo HandleError
Set rs = New ADODB.Recordset
rs.Open "tblRegister", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
With rs
![IDNHHMeter] = Me.txtIDNHHMeter
![Register] = i
.Update
End With
rs.Close
Set rs = Nothing
Exit For
Next

Loop Until i = R

ExitHere:
Exit Sub
HandleError:
MsgBox Err.Description
Resume ExitHere

End Sub

First thought is you're missing a
command

If you are adding new records then after the
With rs - you need a statement
.AddNew

The .addnew goes with the .Update to add the new record and actually do the update of the table.

 

[Pricey]

You are right. When I was trying to get it going using the select case method I forgot to add it back in. Put it in and it still doesnt work.

Dim R As Integer
Dim i As Integer
Do
For i = 1 To R
Dim rs As ADODB.Recordset
On Error GoTo HandleError
Set rs = New ADODB.Recordset
rs.Open "tblRegister", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
With rs
.AddNew
![IDNHHMeter] = Me.txtIDNHHMeter
![Register] = i
.Update
End With
rs.Close
Set rs = Nothing
Exit For
Next
Loop Until i = R
ExitHere:
Exit Sub
HandleError:
MsgBox Err.Description
Resume ExitHere

End Sub

 

[vbaInet]

Do
For i = 1 To R

I haven't looked at the rest of your code but you haven't initialised R so it was always have the value 0 and the loop will never be executed.
Also, I'm not sure you need two loops, one seems redundant. What's the idea behind that?

 

[Pricey]

I am really not having a good start to posting. Cant believe I hadn't initialised R in my example, it was in my master form. Not sure what my idea is behind 2 loops. I am very new to looping and was trying to copy something out of a book. Removed one of the loops and added the reference to the variable. Any ideas how to get it running. I am now only getting 1 record with the register as 1.

Dim R As Integer
Dim i As Integer

R = Me.txtRegister

For i = 1 To R
Dim rs As ADODB.Recordset
On Error GoTo HandleError
Set rs = New ADODB.Recordset
rs.Open "tblRegister", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
With rs
.AddNew
![IDNHHMeter] = Me.txtIDNHHMeter
![Register] = i
.Update
End With
rs.Close
Set rs = Nothing
Exit For
Next
ExitHere:
Exit Sub
HandleError:
MsgBox Err.Description
Resume ExitHere

End Sub

 

[vbaInet]

It's good you're trying your hands on some code What are you trying to achieve?

Also what is txtRegister?

 

[Pricey]

I think it is good I am trying code. I have only been using access for a couple of months and before that I thought excel was the only way.
I have a form which adds a new record to a table. On this form there is a unbound text box called txtRegister. Once the primary record is saved I then want to setup records in the related table tblRegister. In this related table there is only 3 fields. AutoNumber, IDNHHMeter(foreign key), Register. Basically if I had the number 5 in txtRegister I would want the data saved in the related table 5 times with the register in each record starting at 1 and having an increment of 1 until it got to 5. Below is an example of what it would look like in the table.

IDRegisterIDNHHMeterRegister101500011102500012103500013104500014105500015

 

[Pricey]

That table I added didnt work properly. Try again.

IDRegisterIDNHHMeterRegister101500011102500012103500013104500014105500015

 

[Pricey]

I will just type it in.

IDRegister, IDNHHMeter, Register
101, 50001, 1
102, 50001, 2
103, 50001, 3
104, 50001, 4
105, 50001, 5

 

[vbaInet]

I was just about to say I didn't understand that long line you wrote

I've made some amendments:

    Dim rs As dao.Recordset, i As Integer, regNumber As Integer
    On Error GoTo HandleError
    
    regNumber = Me.txtRegister
    
    Set rs = rs.OpenRecordset("tblRegister")
    With rs
        For i = 1 To regNumber
            .AddNew
            ![IDNHHMeter] = Me.txtIDNHHMeter
            ![Register] = i
            .Update
        Next
    End With
    rs.Close
    Set rs = Nothing
    
ExitHere:
    Exit Sub
    
HandleError:
    MsgBox Err.Description
    Resume ExitHere

My guess is you are using a single user database so no need for adodb, use dao. I've not tested the code so let me know how that works for you. Also notice the indentation, flow of code and declarations. It's good practice.

 

[vbaInet]

By the way, you didn't include the IDREgister field in your code (when adding). What is your primary key in tblRegister?

 

[Pricey]

Thanks for helping me out with this. It is much appreciated.

I tried it but it came up with the error message "object variable or With block variable not set". Removing the error trapping it was tripping up on the line.
Set rs = rs.OpenRecordset("tblRegister")

 

[vbaInet]

Ah, yes correcct. Replace:

Set rs = CurrentDb.OpenRecordset("tblRegister")

 

[Pricey]

Worked Great. Thanks for your help.

 

[vbaInet]

You're welcome!