Need help with exporting excel data to a Database

[JumboCactuar]

Hi,
ive been testing out the following VBA which works "sometimes" but isn't reliable and often after running the script nothing is written in the table.

Sub exportToAccess()


' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
' connect to the Access database
Set cn = New ADODB.Connection


cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & "Data Source=C:\Test\DB.accdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "DATATABLE", cn, adOpenKeyset, adLockOptimistic, adCmdTable
' all records in a table
r = 2 ' the start row in the worksheet


Do While Len(Range("A" & r).Formula) > 0


' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record


.Fields("USERID") = Range("A" & r).Value
.Fields("USERNAM1") = Range("B" & r).Value
.Fields("USENAM2") = Range("C" & r).Value
.Fields("USRDAT") = Range("D" & r).Value
.Fields("USRTIM") = Range("E" & r).Value
' add more fields if necessary…
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

im not sure what is wrong sometimes it works fine, sometimes just 1 record is added or nothing at all is added

i have data on 3 sheets
data1
data2
data3

and been running the following:

Sub exportAll()
Sheets("Temp").Range("A2:e2000").Value = Sheets("data1").Range("A2:e2000").Value
Sheets("Temp").Range("A2002:e4000").Value = Sheets("data2").Range("A2:e2000").Value
Sheets("Temp").Range("A4002:e6000").Value = Sheets("data3").Range("A2:e2000").Value

Range("A1:A6000").Select
    For Each r In Selection
        If r.Text = "" Then
            r.EntireRow.Delete
        End If
    Next r


Sheets("temp").Select

call exportToAccess

End Sub

appreciate any help

 

[JumboCactuar]

Anyway to rewrite this part

r = 2 ' the start row in the worksheet


Do While Len(Range("A" & r).Formula) > 0