ADODB Connection - Header text not extracted & read-only issue - vba

Question

I am delving into the world of VBA data connections, and would appreciate some assistance. The code below is what I have so far, but there are a couple of oddities I can't figure out.
Sub sbADO()
Dim sSQLQry As String
Dim ReturnArray
Dim Conn As New ADODB.Connection
Dim mrs As New ADODB.Recordset
Dim DBPath As String, sconnect As String
DBPath = "C:\USERS\NAME\DOCUMENTS\VBA Work\Data Source.xlsx"
sconnect = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DBPath & ";HDR=Yes';"
Conn.Open sconnect
sSQLQry = "SELECT * From [Sheet1$]"
mrs.Open sSQLQry, Conn
Sheet3.Range("A1").CopyFromRecordset mrs
mrs.Close
Conn.Close
End Sub
This code works, however:
The data pulled in doesn't include Row1 of the dataset (so the headers aren't pulled in)
If the source workbook 'Data Source.xlsx' is open. The code will cause the workbook to open again but in read-only mode. Can this be avoided?
Can the connection string be edited so that the source file is never locked out? ie. queried in Read-Only mode other users can open it whilst the query is being completed?
Any help is appreciated
Thanks
Caleeco

Answer 1

Try this:
Sub sbADO()
Dim sSQLQry As String
Dim ReturnArray
Dim Conn As New ADODB.Connection
Dim mrs As New ADODB.Recordset
Dim DBPath As String, sconnect As String,i as integer
'DBPath = ThisWorkbook.FullName
DBPath = "C:\USERS\NAME\DOCUMENTS\VBA Work\Data Source.xlsx"
sconnect= "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=""" & _
DBPath & """;Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX = 1"""
Conn.Open sconnect
sSQLQry = "SELECT * From [Sheet1$]"
mrs.Open sSQLQry, Conn
if rs.recordcount>0 then
rs.movefirst
for i=0 to rs.fields.count-1
'read here the headers and add them to your sheet in row 1
Sheet3.Cells(1, i + 1) =rs.Fields(i).Name
next
end if
Sheet3.Range("A2").CopyFromRecordset mrs
mrs.Close
Conn.Close
End Sub