Public sub RefreshData()
On Error GoTo SubError
Const DbLoc As String = "V:\Erhverv\Revisorbesvarelse\Revisorbesvarelse.ac cdb"
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
Set xlBook = ActiveWorkbook
Set xlSheet = xlBook.Worksheets("Importeret data")
xlSheet.Range("A2:M1500").ClearContents
Application.StatusBar = "Connecting to an external database..."
Application.Cursor = xlWait
Set db = OpenDatabase(DbLoc)
SQL = "SELECT * " _
& "FROM tbl_revisor " _
Set rs = db.OpenRecordset(SQL, dbOpenSnapshot)
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("A2").CopyFromRecordset rs
Application.StatusBar = "Update complete"
SubExit:
On Error Resume Next
Application.Cursor = xlDefault
rs.Close
Set rs = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Exit Function
SubError:
Application.StatusBar = ""
MsgBox "RefreshData - UpdateData VBA error: " & vbCrLf & Err.Number & " = " & Err.Description
Resume SubExit
End sub