Sub GetProviderIncentiveData()
'Created by Brian Conner on 6/4/2015
Dim objConn As ADODB.Connection
Dim objRS As ADODB.Recordset
Dim strSQL As String
Dim PT As PivotTable
Dim WS As Worksheet
 
strBeginDate = Format(Worksheets("Data").Range("B2").Value, "MM/DD/YYYY")
strEndDate = Format(Worksheets("Data").Range("B3").Value, "MM/DD/YYYY")
 
On Error GoTo err_handler

 Set objConn = New ADODB.Connection
 objConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=\\va10vnas003a4\Shared\CRA_Public\Brian_Conner\Databases\Reporting_SharePoint_Databases.accdb;Persist Security Info=False;"
 Set objRS = New ADODB.Recordset
  strSQL = "SELECT * FROM Worklist WHERE Encounter_Date BETWEEN " & strBeginDate & " AND " & strEndDate & "'"
  
  objRS.Open strSQL, objConn
  
 
  
  
  Worksheets("Data").Range("A2").CopyFromRecordset objRS
  objRS.Close
  Set objRS = Nothing
  objConn.Close
  Set objConn = Nothing
  
  
MsgBox "Data Extraction is complete."
 
 
 
 
 Exit Sub
err_handler:
 MsgBox Err.Number & "-" & Err.Description
  objRS.Close
  Set objRS = Nothing
  objConn.Close
  Set objConn = Nothing
  
End Sub