Transfer data from Excel to Access

See more:

MS-Excel

VBA

Actually when ever i click button it transfer data to access database but problem is when ever i want to enter new record in access databse 1st column is blank den after it store the data. please help me out.this is my code below:-

Sub Mail_workbook_Outlook_2()

Dim newcon As ADODB.Connection
Set newcon = New ADODB.Connection
Dim Recordset As ADODB.Recordset

newcon.Open "provider=microsoft.ace.oledb.12.0;Data source= " + ThisWorkbook.Path & "\DMI-Form-505-ToAccess.accdb"
 ' open a recordset
    Set Recordset = New ADODB.Recordset
Recordset.Open "Sheet3", newcon, adOpenDynamic, adLockOptimistic, adCmdTable

With Recordset
Recordset.AddNew
Dim r As Long

 


r = 15 ' the start row in the worksheet
    Do While Len(Range("B" & r).Formula) > 0
    ' repeat until first empty cell in column A
       With Recordset
           .AddNew
           ' create a new record
            ' add values to each field in the record
          
            
            .Fields(5) = Range("A" & r).Value
           .Fields(6) = Range("C" & r).Value
           .Fields(7) = Range("B" & r).Value
            .Fields(8) = Range("I" & r).Value
            .Fields(9) = Range("F" & r).Value
           .Fields(10) = Range("G" & r).Value
            .Fields(11) = Range("H" & r).Value
             'add more fields if necessary...
           .Update ' stores the new record
        End With
           r = r + 1 ' next row
  Recordset.Fields(0).Value = Range("C9").Value 'name
Recordset.Fields(1).Value = Range("C10").Value 'department
Recordset.Fields(2).Value = Range("C11").Value  'reason of request
Recordset.Fields(3).Value = Range("I9").Value  'ext
Recordset.Fields(4).Value = Range("I10").Value 'date
 
Loop
Recordset.Update
End With
Recordset.Close
End Sub