Code Listing-Excel VBA to Extract Data from an Access Database

Posted on September 13, 2015 by raylharvey

6

Code listing for video:
Excel VBA to Extract Data from an Access Database

Description:
We will use an Access database as our data source.  We will add a button to an Excel spreadsheet to refresh the data in the spreadsheet.  Then we will embed Visual Basic for Applications (VBA) in the spreadsheet that will:
1.  Clear out data from previous executions of our code
2.  Query our source database
3.  Write the data we retrieve into our spreadsheet
4.  Keep track of how many rows of data we retrieved from the database
5.  Add two SUM formulas at the bottom of our data range

Note:  This is code we have put in our Excel spreadsheet – NOT the Access database.

Resulting spreadsheet:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75

Sub Button2_Click()     Call RefreshData End Sub Sub RefreshData() On Error GoTo SubError     Const DbLoc As String = "C:\Users\ray\Desktop\Export to Excel\LoadExcel.accdb"     Dim db As DAO.Database     Dim rs As DAO.Recordset     Dim xlBook As Workbook     Dim xlSheet As Worksheet     Dim recCount As Long     Dim SQL As String     'Setup references to workbook and sheet     Set xlBook = ActiveWorkbook     Set xlSheet = xlBook.Worksheets(1)     xlSheet.Range("A5:H1500").ClearContents        'Communicate with the user     Application.StatusBar = "Connecting to an external database..."     Application.Cursor = xlWait     Set db = OpenDatabase(DbLoc)        SQL = "SELECT SalesQuarter & '-' & SalesYear, Division, GrossSales, GrossMargin "     SQL = SQL & "FROM QuarterlySales "     SQL = SQL & "WHERE SalesQuarter IN (1, 2) "     SQL = SQL & "ORDER BY SalesYear, SalesQuarter "        'Execute our query and populate the recordset     Set rs = db.OpenRecordset(SQL, dbOpenSnapshot)     'Set rs = db.OpenRecordset("qryQtrSales", dbOpenSnapshot)     'Set rs = db.OpenRecordset("Parts", dbOpenSnapshot)     'Copy recordset to spreadsheet     Application.StatusBar = "Writing to spreadsheet..."     If rs.RecordCount = 0 Then         MsgBox "No data retrieved from database", vbInformation + vbOKOnly, "No Data"         GoTo SubExit     Else         rs.MoveLast         recCount = rs.RecordCount         rs.MoveFirst     End If        xlSheet.Range("C5").CopyFromRecordset rs     xlSheet.Range("C" & recCount + 4 & ":F" & recCount + 4).Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlDouble     xlSheet.Range("E" & recCount + 5).Formula = "=SUM(E5:E" & recCount + 4 & ")"     xlSheet.Range("F" & recCount + 5).Formula = "=SUM(F5:F" & recCount + 4 & ")"     Application.StatusBar = "Update complete" SubExit: On Error Resume Next     Application.Cursor = xlDefault     rs.Close     Set rs = Nothing     Set xlSheet = Nothing     Set xlBook = Nothing     Exit Sub SubError:     Application.StatusBar = ""     MsgBox "RefreshData - UpdateData VBA error: " & vbCrLf & Err.Number & " = " & Err.Description     Resume SubExit    End Sub

6

Posted in Code Listings for Videos.

Post navigation

https://www.youtube.com/watch?v=lF8WMKzLlac