Insert Multiple Rows into Access Database though Excel VBA

C

chacha123

Board Regular
Joined
Dec 4, 2014
Messages
79
Dear all,

I have a question for how to insert multiple rows into Access Database though Excel VBA

Eg: The below is the order form.

( RED is compulsory field to insert into database)

[TABLE="width: 500"]
<tbody>[TR]
[TD]Name[/TD]
[TD] abc[/TD]
[TD][/TD]
[TD]Phone Number[/TD]
[TD]102-630000[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]IC No[/TD]
[TD]6363254A[/TD]
[TD][/TD]
[TD]Email[/TD]
[TD]abc@gmail.com[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Item No[/TD]
[TD]Product Description[/TD]
[TD]Discount Price[/TD]
[TD]QTY[/TD]
[TD]Amount[/TD]
[/TR]
[TR]
[TD]123[/TD]
[TD]Apple[/TD]
[TD]2.50[/TD]
[TD]1[/TD]
[TD]2.50[/TD]
[/TR]
[TR]
[TD]1234[/TD]
[TD]Orange[/TD]
[TD]3.00[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]12345[/TD]
[TD]Grapes[/TD]
[TD]5.00[/TD]
[TD]2[/TD]
[TD]10.00[/TD]
[/TR]
[TR]
[TD]123456[/TD]
[TD]Lemon[/TD]
[TD]2.00[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1234567[/TD]
[TD]Avocado[/TD]
[TD]4.00[/TD]
[TD]1[/TD]
[TD]4.00[/TD]
[/TR]
</tbody>[/TABLE]

For the field Item No, Product Description, Discount Price, QTY and Amount insert when the QTY is not null.


Code: 
Private Sub cmdSubmitOrder_Click()
Dim cn As ADODB.Connection, rs As ADODB.Recordset
Dim sName As String, sNricno As String, sContactno As String, sEmail As String, sItemNo As String, sProdD As String, sDiscP As String, sQty As String, sAmount As String
Dim msg As String, title As String


Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=abc.mdb;"


Set rs = New ADODB.Recordset
rs.Open "STAFFORDER", cn, adOpenKeyset, adLockOptimistic, adCmdTable


'Range("A2").Activate
'Do While Not IsEmpty(ActiveCell)
sName = Cells(1, 2).Value
sNricno = Cells(2, 2).Value
sContactno = Cells(1, 5).Value
sDept = Cells(2, 5).Value


sBprcode = Range("A:A").Value
sProdD = Range("B:B").Value
sDiscP = Range("C:C").Value
sQty = Range("D:D").Value
sAmount = Range("E:E").Value


rs.Filter = "NAME='" & sName & "'"
If rs.EOF Then
Debug.Print "No existing record - adding new..."
rs.Filter = ""
rs.AddNew
rs("NAME").Value = sName
rs("NRICNO").Value = sNricno
rs("CONTACTNO").Value = sContactno
rs("EMAIL").Value = sEmail
Dim cell As Range
For Each cell In Range("D:D")
If cell.Value = vbNullString Then
rs("BPRCODE").Value = ""
rs("PRODDESC").Value = ""
rs("DISCPRICE").Value = ""
rs("QTY").Value = ""
rs("AMOUNT").Value = ""
Else
rs("BPRCODE").Value = sBprcode
rs("PRODDESC").Value = sProdD
rs("DISCPRICE").Value = sDiscP
rs("QTY").Value = sQty
rs("AMOUNT").Value = sAmount
End If
Next cell
Else
MsgBox "Existing record found..", vbExclamation, "Info"
'Debug.Print "Existing record found..."
End If
Dim cell2 As Range
For Each cell2 In Range("D:D")
If cell2.Value = vbNullString Then
rs("BPRCODE").Value = ""
rs("PRODDESC").Value = ""
rs("DISCPRICE").Value = ""
rs("QTY").Value = ""
rs("AMOUNT").Value = ""
Else
rs("BPRCODE").Value = sBprcode
rs("PRODDESC").Value = sProdD
rs("DISCPRICE").Value = sDiscP
rs("QTY").Value = sQty
rs("AMOUNT").Value = sAmount
End If
Next cell2

rs.Update
MsgBox "...record update complete.", vbExclamation, "Info"
'Debug.Print "...record update complete."




rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

Database Structure

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Field Name [/TD]
[TD]Data Type[/TD]
[/TR]
[TR]
[TD]ORDERID[/TD]
[TD]AUTONUMBER[/TD]
[/TR]
[TR]
[TD]STAFFID[/TD]
[TD]NUMBER[/TD]
[/TR]
[TR]
[TD]NAME[/TD]
[TD]TEXT[/TD]
[/TR]
[TR]
[TD]NRICNO[/TD]
[TD]TEXT[/TD]
[/TR]
[TR]
[TD]CONTACTNO[/TD]
[TD]TEXT[/TD]
[/TR]
[TR]
[TD]EMAIL[/TD]
[TD]TEXT
[/TD]
[/TR]
[TR]
[TD]ITEMCODE[/TD]
[TD]NUMBER[/TD]
[/TR]
[TR]
[TD]PRODDESC[/TD]
[TD]TEXT[/TD]
[/TR]
[TR]
[TD]DISCPRICE[/TD]
[TD]CURRENCY[/TD]
[/TR]
[TR]
[TD]QTY[/TD]
[TD]NUMBER[/TD]
[/TR]
[TR]
[TD]AMOUNT[/TD]
[TD]CURRENCY[/TD]
[/TR]
</tbody>[/TABLE]


I had try use this code, but it seem like can't work.

I need your help. Thanks
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Sort by date Sort by votes
It appears that you want to add multiple orders to the table for a given user

Since the source data does not contain an order number

All orders must be treated as new ( additional ) rather than as an Update



so the code is simpler


also you were originally using strings to contain unbounded arrays "sBprcode = Range("A:A").Value " if the used range on A was 2500 rows what would the string look like?


The sEmail string was not actually being initialised I used the sDept cell instead but you can adjust that

Code: 
Private Sub cmdSubmitOrder_Click()
Dim cn As ADODB.Connection, rs As ADODB.Recordset
Dim msg As String
Dim title As String
Dim MyCell As Range
Dim RecCt As Long
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=abc.mdb;"
RecCt = 0
Set rs = New ADODB.Recordset
rs.Open "STAFFORDER", cn, adOpenKeyset, adLockOptimistic, adCmdTable  'open table
RangeDepth = Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row)  'get max used range of the QTY column
        For Each MyCell In RangeDepth    ' check qty column
            If MyCell.Value <> vbNullString Then  ' if a qty is specified  must be a valid record
                rs.AddNew   ' each order is a new record  ( as in there is NO unique order number on the input data  )
                rs("NAME").Value = Cells(1, 2).Value
                rs("NRICNO").Value = Cells(2, 2).Value
                rs("CONTACTNO").Value = Cells(1, 5).Value
                rs("EMAIL").Value = Cells(2, 5).Value
                rs("BPRCODE").Value = MyCell.Offset(0, -3).Value
                rs("PRODDESC").Value = MyCell.Offset(0, -2).Value
                rs("DISCPRICE").Value = MyCell.Offset(0, -1).Value
                rs("QTY").Value = MyCell.Value
                rs("AMOUNT").Value = MyCell.Offset(0, 1).Value
                rs.Update   'update table
                RecCt = RecCt + 1
            End If
        Next cell
MsgBox RecCt & " New records added.", vbExclamation, "Info"
'Debug.Print "...record update complete."
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
 
Upvote 0
Hi Charles,

I had tried it and change the range as well.
But for the variable RangeDepth have small error

Code: 
[B]Dim RangeDepth As Variant[/B]
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=StaffPurchase.mdb;"
RecCt = 0
Set rs = New ADODB.Recordset
rs.Open "STAFFORDER", cn, adOpenKeyset, adLockOptimistic, adCmdTable
RangeDepth = Range("H12:H" & Cells(Rows.Count, "H").End(xlUp).Row)
[COLOR=#ff0000][B]For Each MyCell In RangeDepth (error here)[/B][/COLOR]

Error Message:

For Each may only iterate over a collection object or an array.
 
Last edited by a moderator:
Upvote 0
Hi Charles,

Kindly ignore the Third Post.

I would like to have the Update Function.

Do i need to use the Order ID?
 
Last edited by a moderator:
Upvote 0
Your orderid number would need to be associated with the order (!)

then change your to filter OrderID

and if eof

rs.AddNew

else

rs.Edit


BUT make sure that the correct OrderID is for the correct person

So maybe revisit your KEYS on the Table to include a unique OrderID, "_", StaffID Index

(the "_" stops the orderID and StaffID blending into something unexpected)

and then your filter is PrimaryKey = OrderID & "_" & StaffID
 
Upvote 0
Hi Charles,

So which mean the OrderID set as Primary Key in database?

In the Form, should I include an Order ID field?


Code: 
Private Sub cmdSubmitOrder_Click()
Dim cn As ADODB.Connection, rs As ADODB.Recordset
Dim msg As String, title As String
Dim MyCell As Range
Dim RecCt As Long
Dim RangeDepth As Range
Dim sid As String


sid = Cells(7, 8).Value & Cells(5, 8).Value
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=abc.mdb;"
RecCt = 0
Set rs = New ADODB.Recordset
rs.Open "STAFFORDER", cn, adOpenKeyset, adLockOptimistic, adCmdTable
Set RangeDepth = Range("H12:H" & Cells(Rows.Count, "H").End(xlUp).Row)
sid = Cells(4, 1).Value
rs.Filter = "ORDERID='" & sid & "'"
For Each MyCell In RangeDepth
If MyCell.Value <> vbNullString Then
If rs.EOF Then
rs.AddNew
rs("ORDERID").Value = sid
rs("STAFFID").Value = Cells(5, 8).Value
rs("NAME").Value = Cells(3, 4).Value
rs("NRICNO").Value = Cells(5, 4).Value
rs("CONTACTNO").Value = Cells(7, 4).Value
rs("DEPT").Value = Cells(3, 8).Value
rs("MONTH").Value = Cells(7, 8).Value
rs("BPRCODE").Value = MyCell.Offset(0, -6).Value
rs("PRODDESC").Value = MyCell.Offset(0, -4).Value
rs("DISCPRICE").Value = MyCell.Offset(0, -1).Value
rs("QTY").Value = MyCell.Offset(0, 0).Value
rs("AMOUNT").Value = MyCell.Offset(0, 1).Value
MsgBox RecCt & "New Records Added", vbExclamation, "Info"
Else
'Debug.Print "Existing record found..."


End If
rs("BPRCODE").Value = MyCell.Offset(0, -6).Value
rs("PRODDESC").Value = MyCell.Offset(0, -4).Value
rs("DISCPRICE").Value = MyCell.Offset(0, -1).Value
rs("QTY").Value = MyCell.Offset(0, 0).Value
rs("AMOUNT").Value = MyCell.Offset(0, 1).Value
rs.Update
RecCt = RecCt + 1
End If
Next MyCell
MsgBox RecCt & "Records Updated", vbExclamation, "Info"


rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

The MsgBox pop up but the record didn't insert/update
 
Last edited by a moderator:
Upvote 0
The code was completely wrong


More Like

Code: 
Private Sub cmdSubmitOrder_Click()
Dim cn As ADODB.Connection, rs As ADODB.Recordset
Dim msg As String, title As String
Dim MyCell As Range
Dim RecAddCt As Long
Dim RecUpdCt As Long
Dim RangeDepth As Range
Dim sid As String

sid = Cells(7, 8).Value & Cells(5, 8).Value
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=abc.mdb;"
RecAddCt = 0
RecUpdCt = 0
Set rs = New ADODB.Recordset
rs.Open "STAFFORDER", cn, adOpenKeyset, adLockOptimistic, adCmdTable
Set RangeDepth = Range("H12:H" & Cells(Rows.Count, "H").End(xlUp).Row)

For Each MyCell In RangeDepth
    sid = MyCell.Offset(0, -7).Value  '
    rs.Filter = "ORDERID='" & sid & "'"
    If rs.EOF Then
        If MyCell.Value <> vbNullString Then
        
            rs.AddNew
            rs("ORDERID").Value = sid
            rs("STAFFID").Value = Cells(5, 8).Value
            rs("NAME").Value = Cells(3, 4).Value
            rs("NRICNO").Value = Cells(5, 4).Value
            rs("CONTACTNO").Value = Cells(7, 4).Value
            rs("DEPT").Value = Cells(3, 8).Value
            rs("MONTH").Value = Cells(7, 8).Value
            rs("BPRCODE").Value = MyCell.Offset(0, -6).Value
            rs("PRODDESC").Value = MyCell.Offset(0, -4).Value
            rs("DISCPRICE").Value = MyCell.Offset(0, -1).Value
            rs("QTY").Value = MyCell.Offset(0, 0).Value
            rs("AMOUNT").Value = MyCell.Offset(0, 1).Value
            RecAddCt = RecAddCt + 1
            rs.Update
        End If
    Else
        If MyCell.Value <> vbNullString Then
            rs.Edit
            rs("BPRCODE").Value = MyCell.Offset(0, -6).Value
            rs("PRODDESC").Value = MyCell.Offset(0, -4).Value
            rs("DISCPRICE").Value = MyCell.Offset(0, -1).Value
            rs("QTY").Value = MyCell.Offset(0, 0).Value
            rs("AMOUNT").Value = MyCell.Offset(0, 1).Value
            RecUpdCt = RecUpdCt + 1
            rs.Update
        End If
        
    End If
Next MyCell
MsgBox RecAddCt & "New Records Added and " & RecUpdCt & "Records Updated", vbExclamation, "Info"

rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

BUT

I think, from what you attempted to do, you want all the different quantity lines to make up one order?

so your table structure is wrong

the current one becomes the order summary or Header

and you need to create a table of order lines for each qty entry.....

and then you're into the management of that

Do you add a new order line to an order, or does another entry cause the orderlines for an order to be cleared down and the new lines become that order ??

I imagined that each line was an order, but that is not what you've attempted to do by having multiple orderid entries you than have to check each line against the table to see If its new or changed or for deletion?

I think before cutting anymore code you need to consider again what you ACTUALLY attempting to achieve
 
Upvote 0
CharlesChuckieCharles said:
The code was completely wrong


More Like

Code: 
Private Sub cmdSubmitOrder_Click()
Dim cn As ADODB.Connection, rs As ADODB.Recordset
Dim msg As String, title As String
Dim MyCell As Range
Dim RecAddCt As Long
Dim RecUpdCt As Long
Dim RangeDepth As Range
Dim sid As String

sid = Cells(7, 8).Value & Cells(5, 8).Value
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=abc.mdb;"
RecAddCt = 0
RecUpdCt = 0
Set rs = New ADODB.Recordset
rs.Open "STAFFORDER", cn, adOpenKeyset, adLockOptimistic, adCmdTable
Set RangeDepth = Range("H12:H" & Cells(Rows.Count, "H").End(xlUp).Row)

For Each MyCell In RangeDepth
    sid = MyCell.Offset(0, -7).Value  '
    rs.Filter = "ORDERID='" & sid & "'"
    If rs.EOF Then
        If MyCell.Value <> vbNullString Then
        
            rs.AddNew
            rs("ORDERID").Value = sid
            rs("STAFFID").Value = Cells(5, 8).Value
            rs("NAME").Value = Cells(3, 4).Value
            rs("NRICNO").Value = Cells(5, 4).Value
            rs("CONTACTNO").Value = Cells(7, 4).Value
            rs("DEPT").Value = Cells(3, 8).Value
            rs("MONTH").Value = Cells(7, 8).Value
            rs("BPRCODE").Value = MyCell.Offset(0, -6).Value
            rs("PRODDESC").Value = MyCell.Offset(0, -4).Value
            rs("DISCPRICE").Value = MyCell.Offset(0, -1).Value
            rs("QTY").Value = MyCell.Offset(0, 0).Value
            rs("AMOUNT").Value = MyCell.Offset(0, 1).Value
            RecAddCt = RecAddCt + 1
            rs.Update
        End If
    Else
        If MyCell.Value <> vbNullString Then
            rs.Edit
            rs("BPRCODE").Value = MyCell.Offset(0, -6).Value
            rs("PRODDESC").Value = MyCell.Offset(0, -4).Value
            rs("DISCPRICE").Value = MyCell.Offset(0, -1).Value
            rs("QTY").Value = MyCell.Offset(0, 0).Value
            rs("AMOUNT").Value = MyCell.Offset(0, 1).Value
            RecUpdCt = RecUpdCt + 1
            rs.Update
        End If
        
    End If
Next MyCell
MsgBox RecAddCt & "New Records Added and " & RecUpdCt & "Records Updated", vbExclamation, "Info"

rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

BUT

I think, from what you attempted to do, you want all the different quantity lines to make up one order?

so your table structure is wrong

the current one becomes the order summary or Header

and you need to create a table of order lines for each qty entry.....

and then you're into the management of that

Do you add a new order line to an order, or does another entry cause the orderlines for an order to be cleared down and the new lines become that order ??

I imagined that each line was an order, but that is not what you've attempted to do by having multiple orderid entries you than have to check each line against the table to see If its new or changed or for deletion?

I think before cutting anymore code you need to consider again what you ACTUALLY attempting to achieve
Click to expand...

Hi Charles,

Current, my table structure is order summary or header, right?

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Field Name[/TD]
[TD]Data Type[/TD]
[/TR]
[TR]
[TD]MONTH[/TD]
[TD]TEXT[/TD]
[/TR]
[TR]
[TD]STAFFID[/TD]
[TD]NUMBER[/TD]
[/TR]
[TR]
[TD]NAME[/TD]
[TD]TEXT[/TD]
[/TR]
[TR]
[TD]BPRCODE[/TD]
[TD]NUMBER[/TD]
[/TR]
[TR]
[TD]QTY[/TD]
[TD]NUMBER[/TD]
[/TR]
[TR]
[TD]PRODDESC[/TD]
[TD]TEXT[/TD]
[/TR]
[TR]
[TD]DISCPRICE[/TD]
[TD]CURRENCY[/TD]
[/TR]
[TR]
[TD]AMOUNT[/TD]
[TD]CURRENCY[/TD]
[/TR]
[TR]
[TD]DEPT[/TD]
[TD]TEXT[/TD]
[/TR]
[TR]
[TD]ORDERID[/TD]
[TD]TEXT[/TD]
[/TR]
[TR]
[TD]NRICNO[/TD]
[TD]TEXT[/TD]
[/TR]
[TR]
[TD]CONTACTNO[/TD]
[TD]TEXT[/TD]
[/TR]
</tbody>[/TABLE]

Based on you advise, I should create another table for Order Lines for each qty entry

May I know is the below table is the one should i create?

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]FIELD NAME[/TD]
[TD]DATA TYPE[/TD]
[/TR]
[TR]
[TD]ORDERID[/TD]
[TD]NUMBER (PK)[/TD]
[/TR]
[TR]
[TD]BPRCODE[/TD]
[TD]NUMBER[/TD]
[/TR]
[TR]
[TD]QTY[/TD]
[TD]NUMBER[/TD]
[/TR]
</tbody>[/TABLE]

Sorry, Charles. Make you confusing.


Happy New Year
Thanks
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Solved
Trouble running an access query in excel vba
Replies
2
Views
155
Legal Tender
L
D
  • Question Question
Transfer Data from Access Database to Excel userform
Replies
0
Views
743
DanSMT
D
D
  • Solved
Pulling data from Access Database to Excel
Replies
2
Views
2K
smozgur
smozgur
R
  • Question Question
Save Current Sheet as PDF and Link that PDF in Access
Replies
0
Views
1K
Ryandeal92
R
T
  • Question Question
Insert/Delete Columns issue via VBA
Replies
1
Views
819
Tdorman
T

Forum statistics

Threads
1,223,907
Messages
6,175,300
Members
452,633
Latest member
DougMo

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top