Efficiently Importing Large Records to MS - Access

Sub exporttodb()
Dim db As Object
Dim rs As Object
Dim conn As Object
Dim strsql As String
Dim accessDB As String
Dim tablename As String
Dim dataarray() As Variant
Dim batchsize As Long
Dim i As Long
Dim j As Long
Dim wbs As Workbook
Dim ws As Worksheet
Dim fd As FileDialog
Dim selws As Worksheet
Dim lastcol As Integer
Dim lastrow As Long
Dim selectedfile As Object
Dim listboxcounter As Integer
Dim currentTotalRecords As Long
Dim currentrowrecord As Long


 
    'set the DB path and table name
    accessDB = ThisWorkbook.Worksheets("References").Range("F1").Value & ThisWorkbook.Worksheets("References").Range("F2").Value
    tablename = "Consolidated Inventory+FFE 2"
  

    'Create Access Database and  recordset objects
    Set db = CreateObject("Access.Application")
    db.opencurrentdatabase accessDB
    Set rs = db.currentdb.openrecordset(tablename)

    'set the connection string for the recordset and delete the existing records.
    Set conn = CreateObject("ADODB.Connection")
    conn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & accessDB & ";")
    strsql = "DELETE * FROM [" & tablename & "];"
    conn.Execute strsql
  
    'Import the records.
    Set fd = Application.FileDialog(msoFileDialogOpen)
        With fd
            .AllowMultiSelect = False
            .Title = "Select Workbooks"
            .Filters.Clear
            .Filters.Add "Excel Files", "*.xls; *.xlsx; *.xslm; *.xlsb", 1
          
                If .Show - 1 Then
                    For Each selItems In .SelectedItems
                        Set wbs = Workbooks.Open(selItems)
                  
                        For Each ws In wbs.Sheets
                            listboxcounter = listboxcounter + 1
                          
                            'Add the sheetnames in the listbox
                            Sheetsel.ListBox1.AddItem ws.Name
                        Next ws
                            Sheetsel.Show
                    Next selItems
                End If
              
                'Prepare the data for export
                If selectedv <> "" Then
                    Set selws = wbs.Worksheets(selectedv)
                    lastcol = selws.Cells(1, selws.Columns.Count).End(xlToLeft).Column
                    lastrow = selws.Cells(selws.Rows.Count, 2).End(xlUp).Row
                  
                End If
        End With
      
        batchsize = 1000
        currentTotalRecords = rs.RecordCount
      
       'Loop through the data in batchsize
        For currentrowrecord = 2 To lastrow Step batchsize
     
            'resize the array to matcht the data in the current batch
            ReDim dataarray(1 To batchsize, 1 To lastcol)

            'populate the array with data from the source sheet
            For i = 1 To batchsize
                For j = 1 To lastcol
                    dataarray(i, j) = selws.Cells(currentrowrecord + i - 1, j).Value
                Next j
            Next i
          
            'Insert the batch to the access db
            On Error Resume Next
              
                For i = 1 To batchsize
                rs.AddNew
                    For j = 1 To lastcol
                        rs.Fields(j - 1).Value = dataarray(i, j)
                    Next j
                rs.Update
                  
                Next i
          
       Next currentrowrecord
      
 End Sub