VBA and Databases: Connecting Excel to SQL Server, Access, and Beyond

'=======================================
' Module: modDB
' Purpose: Handle all database connections
'=======================================
Option Explicit

Private conn As Object ' ADODB.Connection
Private rs As Object ' ADODB.Recordset
Private Const ADMIN_EMAIL As String = "VBAdmin@company.com"

' --- Connect to SQL Server ---
Public Function ConnectSQLServer(ByVal serverName As String, _
     ByVal databaseName As String, _
     ByVal user As String, _
     ByVal password As String) As Boolean
     On Error GoTo ErrHandler

     Set conn = CreateObject("ADODB.Connection")
     Dim connStr As String
     connStr = "Provider=SQLOLEDB;" & _
         "Data Source=" & serverName & ";" & _
         "Initial Catalog=" & databaseName & ";" & _
         "User ID=" & user & ";" & _
         "Password=" & password

     conn.Open connStr
     ConnectSQLServer = True
     Exit Function

ErrHandler:
     ErrorHandler.LogError "ConnectSQLServer", Erl
     ConnectSQLServer = False
End Function

' --- Connect to Access ---
Public Function ConnectAccess(ByVal dbPath As String) As Boolean
     On Error GoTo ErrHandler
     Set conn = CreateObject("ADODB.Connection")
     Dim connStr As String
     connStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath & ";"
     conn.Open connStr
     ConnectAccess = True
     Exit Function

ErrHandler:
     ErrorHandler.LogError "ConnectAccess", Erl
     ConnectAccess = False
End Function

' --- Run a Query and Return Results ---
Public Function RunQuery(ByVal sql As String) As Object
     On Error GoTo ErrHandler
     Set rs = CreateObject("ADODB.Recordset")
     rs.Open sql, conn, 1, 3 ' adOpenKeyset, adLockOptimistic
     Set RunQuery = rs
     Exit Function

ErrHandler:
     ErrorHandler.LogError "RunQuery", Erl
End Function

' --- Execute Non-Query (INSERT, UPDATE, DELETE) ---
Public Sub ExecuteSQL(ByVal sql As String)
     On Error GoTo ErrHandler
     conn.Execute sql
     Exit Sub

ErrHandler:
     ErrorHandler.LogError "ExecuteSQL", Erl
End Sub

' --- Close Connections ---
Public Sub CloseDB()
     On Error Resume Next
     If Not rs Is Nothing Then If rs.State = 1 Then rs.Close
     If Not conn Is Nothing Then If conn.State = 1 Then conn.Close
     Set rs = Nothing
     Set conn = Nothing
End Sub

'=================================
' Module: ErrorHandler
'=================================
Option Explicit

Private errorBuffer As Collection
Private Const ADMIN_EMAIL As String = "VBAdmin@company.com"

Public Sub LogError(ByVal procName As String, ByVal lineNum As Long)
     If errorBuffer Is Nothing Then Set errorBuffer = New Collection
     Dim entry As String
     entry = Now & " | " & procName & " | Line " & lineNum & " | Err " & Err.Number & ": " & Err.Description
     errorBuffer.Add entry
End Sub

Public Sub FlushErrors()
     If errorBuffer Is Nothing Then Exit Sub
     If errorBuffer.Count = 0 Then Exit Sub

     Dim logPath As String, fNum As Integer, entry As Variant
     logPath = ThisWorkbook.Path & "\ErrorLogFile " & Format(Now, "yyyy-mm-dd hh-nn-ss") & ".txt"

     fNum = FreeFile()
     Open logPath For Output As #fNum
     Print #fNum, "Error Log - " & Now
     For Each entry In errorBuffer
         Print #fNum, entry
     Next entry
     Close #fNum

     Call SendErrorEmail(logPath)
     Set errorBuffer = Nothing
End Sub

Private Sub SendErrorEmail(ByVal logPath As String)
     On Error Resume Next
     Dim olApp As Object, olMail As Object
     Set olApp = CreateObject("Outlook.Application")
     Set olMail = olApp.CreateItem(0)

     With olMail
         .To = ADMIN_EMAIL
         .Subject = "Database Error Report"
         .Body = "Please find the attached error log for details."
         .Attachments.Add logPath
         .Send
     End With
End Sub

Sub ImportDataFromSQL()
     On Error GoTo ErrHandler

     Dim rs As Object
     Dim sql As String
     Dim ws As Worksheet
     Set ws = ThisWorkbook.Sheets("Data")

     If ConnectSQLServer("ServerName", "DatabaseName", "User", "Password") Then
         sql = "SELECT TOP 100 * FROM Employees ORDER BY EmployeeID"
         Set rs = RunQuery(sql)

         Dim r As Long, c As Long
         r = 2
         Do Until rs.EOF
             For c = 0 To rs.Fields.Count - 1
                 ws.Cells(r, c + 1).Value = rs.Fields(c).Value
             Next c
             r = r + 1
             rs.MoveNext
         Loop

         CloseDB
         MsgBox "Data imported successfully!", vbInformation
     Else
         MsgBox "Connection failed.", vbCritical
     End If

     FlushErrors
     Exit Sub

ErrHandler:
     ErrorHandler.LogError "ImportDataFromSQL", Erl
     FlushErrors
End Sub