Import Access query results into Excel show import status

I am using the code below to import
the results of an Access query into Excel.
The process takes about 60-75 seconds. How
can I display a status bar showing how much of the import
is complete. Either number of record count or a status bar % complete.





Dim cn As Object
Dim rs1 As Object
Dim rs2 As Object
Dim rs3 As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim x As Integer
Dim rowcount As Integer


Sheets("Central").Select
Sheets("Central").Activate

strFile = "S:\Health Economics\Team Members\Mark\Magnolia_Membership.accdb"

strCon = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strFile

Set cn = CreateObject("ADODB.Connection")
cn.Open strCon


strSQL = "SELECT * from qry1;"

'Added the following four lines
Set rs1 = CreateObject("ADODB.RECORDSET")
rs1.activeconnection = cn
rs1.Open strSQL

Range("D3:M6000").Select
Selection.ClearContents

Range("D3").CopyFromRecordset rs1

rs1.Close