Connect To A Database & Pull Data via SQL (To Excel Sheet)

This codes connects to a database and pulls all data back to an excel sheet via SQL and adds an auto filter to the top of the sheet. This code does an access check to ensure the user only sees data they have permission to view.

'ignore errors and move on - only errors will be BOF or EOF errors and they do not matter. On Error Resume Next 'switch off app alearts so search errors do not occur if data not in db Application.DisplayAlerts = False 'unload menu and show please wait dialog frmWait.Show 'Shutdown screen updating Application.ScreenUpdating = False 'Wait until wait form loads 3 secs should do :)   dtTime = Now    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:03")    'select output sheet    Sheets("Data").Activate    '#####################    'Populating Data Sheet    '#####################    'activate data sheet 1    Sheets("Data").Activate    'clear the sheet    Range("Data!A1:Z5000").Value = ""    'Reading Data from DB    Dim cn As ADODB.Connection, rs As ADODB.Recordset    ' connect to the database    Set cn = New ADODB.Connection     cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _     "Data Source=\\C900000FSL0001\Hxd$\HCA\10. MPT Scotland\Shared\Abs\Data\A_DB.mdb;" & _     "Jet OLEDB:Database Password=thrufelt;"   ' open a recordset for the correct table    Set rs = New ADODB.Recordset    'Build SQL to get data    Dim sql As String    'Check Access Level to pull the correct data to this tab.    'If the user has access 1 then this is full system access so select all and download it. If Range("Abs!L3").Value = "1" Then sql = "SELECT * FROM qryLongTerm_Abs" Else 'This user does not have admin access only give them access to allowed level. sql = "SELECT * FROM qryLongTerm_Abs WHERE [AL] = " & Range("Abs!L3").Value End If   'Run SQL to get data into recordset rs.Open sql, cn, adOpenDynamic 'If EOF (data not found before end of file) quit and display error. If rs.EOF Then MsgBox "The report you have selected has no data or you do not have access to this data.", vbCritical, "Abs" Range("Data!A1:Z5000").Value = "" Unload frmWait Sheets("Abs").Activate Exit Sub End If           'select output sheet Sheets("Data").Activate 'move to the first record in recordset rs.MoveFirst 'Set counter to 0 I = 0 'put field names onto the data sheet For I = 0 To rs.Fields.Count - 1 ActiveSheet.Cells(6, I + 1).Value = rs.Fields(I).Name Next I           'copy all data from recordset to sheet ActiveSheet.Cells(7, 1).CopyFromRecordset rs   'set the range so the chart can pick this up for all data on tab (Except this has no charts so its just creating a names range - dunno why - just never deleted this code) Dim rngRowSource1 As Range Set rngRowSource1 = Range(Range("IV1").End(xlToLeft), Range("A65536").End(xlUp)) 'Pop and autofilter on the data 'check for filter, turn on if none exists If Not ActiveSheet.AutoFilterMode Then ActiveSheet.Range("A6").AutoFilter End If   'Close the recordset down coz we are done with it right now rs.Close Set rs = Nothing 'closing down DB   cn.Close Set cn = Nothing 'unload please wait warning Unload frmWait 'Close the menu Unload Me   'Switch on screen updating Application.ScreenUpdating = True 'switch on app alearts Application.DisplayAlerts = True

Code Snippits