VBA to pull Access Data

Hi folks,

Below is the sample code written to pull data from MS Access database.

Option Explicit

Public Const sPASSWORD = "" 'Your DB Password here

Public Const sDBPath = "\Drive\DBPath" 'Your DB Path here

 

'I wrote this code to pull data from MS Access and to show up in a sheet called "Import Data"

'The code pulls data only for a particular week selected. Modify the query as per the requirement

'Some of the lines will be irrelevant but I still have them as I was testing the code with many options.

 

 

Sub importData()

Dim db As DAO.Database

Dim rs As DAO.Recordset

 

 

'New variables

Dim lRowCounter As Long 'Count rows to populate worksheet from query

Dim lastCell As Object

Dim endrow As Integer

Dim Ws As Worksheet

Dim i As Variant

Dim sWeek As String

 

'Turn off auto calculation to run the code faster

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

 

sWeek = Sheets("Admin").Range("K2").Value

 

'Clear column data

Set Ws = Sheets("ImportData")

Ws.Select

Set lastCell = Columns("A").Find("")

endrow = lastCell.Row

Range("A1:P" & endrow).Select

Selection.ClearContents

 

Range("A1").Select 'Set active cell

lRowCounter = 1

 

'Connect to DB

 

'DB exist

Set db = DBEngine.OpenDatabase(sDBPath, False, True, ";pwd=" & sPASSWORD)

'Set QueryDef = db.QueryDefs("qryReport")

'Set rs = QueryDef.OpenRecordset()

 

Set rs = db.OpenRecordset("SELECT tblUtilization.DATE_D, tblEmpDetails.E_NAME_T, tblUtilization.UNITS_N, tblUtilization.TIME_N, tblUtilization.ACCURACY_N, tblUtilization.ONTIME_N, tblUtilization.REMARKS_T, tblReports.TRANS_T, tblDate.Week_T, tblDate.Month_T FROM ((tblUtilization INNER JOIN tblEmpDetails ON tblUtilization.E_LANID_T = tblEmpDetails.E_LANID_T) INNER JOIN tblReports ON tblUtilization.REPORT_T = tblReports.REPORT_T) INNER JOIN tblDate ON tblUtilization.DATE_D = tblDate.Date_D WHERE (((tblDate.Week_T)=""" & sWeek & """))")

 

 

'This loop will collect the field names and place them in the first

'row starting at "A1."

For i = 0 To rs.Fields.Count - 1

Ws.Cells(1, i + 1).Value = rs.Fields(i).Name

Next

 

'This line simply sets the font to bold for the headers.

Ws.Range(Ws.Cells(1, 1), Ws.Cells(1, rs.Fields.Count)).Font.Bold _

= True

 

'The next line will get the data from the recordset and copy it

'into the Worksheet (Sheet1).

 

Ws.Range("A2").CopyFromRecordset rs

 

'This next code set will just select the data region and auto-fit

'the columns

Ws.Select

Range("A1").Select

Selection.CurrentRegion.Select

Selection.Columns.AutoFit

Range("A1").Select

 

rs.Close

db.Close

Application.Calculation = xlCalculationAutomatic

 

Sheets("Report").Select

End Sub