Export Excel Data To Access

Sub ExportDataIntoAccessFast()
Dim Conn As ADODB.Connection
Dim rs As New ADODB.Recordset
Set cn = New ADODB.Connection
On Error Resume Next
Set selectedRange = Application.InputBox("Select the columns to copy to the Access database, including the header row.", "Select Data Range", Type:=8)
On Error GoTo 0

' Check if the user canceled or didn't select a valid range
If selectedRange Is Nothing Then
MsgBox "No data range selected. Operation cancelled.", vbExclamation
Exit Sub
End If

Const AccessStr As String = "Provider = Microsoft.ACE.OLEDB.12.0;Data Source=S:\VBA\Worker Aids\APRA.accdb;Persist Security Info=False;"
cn.connectionString = AccessStr
cn.Open

FileName = Application.ActiveWorkbook.FullName
XName = ActiveSheet.Name
wsName = "[" & XName & "$]"

MyTable = "Report"

ssql = "INSERT INTO " & MyTable & " SELECT * " & " FROM [Excel 8.0;HDR=YES;DATABASE=" & FileName & "]." & wsName
cn.Execute ssql

End Sub