Load Excel Name Range Data to SQL Server table, VBA

Sub ShowRecordCount()
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
With cn
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .ConnectionString = "Data Source=C:\temp\JW_E&PM_041.xlsx;" & _
"Extended Properties=Excel 12.0;"
    .Open
End With

sSQL = "SELECT * FROM rngloaddata"

Set oRs = New ADODB.Recordset
oRs.Open sSQL, cn, adOpenStatic, adLockBatchOptimistic, adCmdText

Set cn2 = CreateObject("ADODB.Connection")
    With cn2
        .CursorLocation = adUseClient
        .Open "Driver={SQL Server};Server=Server01; Database=budget; UID=DB; PWD=xxxxxx"
        .CommandTimeout = 0
        oRs.MoveFirst
       
   
   
    For i = 0 To Range("rngloaddata").Columns.Count - 1
        strcolnmName = strcolnmName & ", CAST('' AS VARCHAR(255))" & oRs.Fields(i).Name
       
    Next
   
    tablstr = "IF OBJECT_ID('tempdb..##temp1345') IS NOT NULL  drop table ##temp1345     select  " & Right(strcolnmName, Len(strcolnmName) - 1) & " into ##temp1345"
    Debug.Print tablstr
    .Execute tablstr
    Debug.Print tablstr
   
    Do While Not oRs.EOF
    strcolnmValue = ""
            For i = 0 To Range("rngloaddata").Columns.Count - 1
                strcolnmValue = strcolnmValue & ",'" & oRs.Fields(i) & "'"
            Next
       
        .Execute "INSERT INTO ##temp1345 select " & Right(strcolnmValue, Len(strcolnmValue) - 1)
           
            oRs.MoveNext
            Loop
    End With

cn.Close
End Sub