Excel VBA：データベースを操作するクラス

Excel VBA

2020.07.21 2020.07.13

サンプルコード

Option Explicit

Private con As Object
Private com As Object
Private rec As Object

Private Sub Class_Initialize()

    Set con = CreateObject("ADODB.Connection")
    Set com = CreateObject("ADODB.Command")
    Set rec = CreateObject("ADODB.Recordset")
End Sub

Private Sub Class_Terminate()

    If Not rec Is Nothing Then
    
        If rec.State > 0 Then rec.Close
        Set rec = Nothing
    End If
    
    If Not com Is Nothing Then Set com = Nothing
    
    If Not con Is Nothing Then
    
        If con.State > 0 Then con.Close
        Set con = Nothing
    End If
End Sub

Public Function Connect(ByVal connection_string As String, Optional ByVal result As Boolean = True) As Boolean

    On Error GoTo ErrorHandler
    
    con.ConnectionString = connection_string
    con.Open
    com.ActiveConnection = con
    com.CommandType = 1
    
Finally:

    Connect = result
    Exit Function
    
ErrorHandler:

    result = False
    Call ShowError(Err)
    GoTo Finally
End Function

Public Function SetSql(ByVal sql As String)

    com.CommandText = sql
End Function

Public Sub AddBigIntParameter(ByVal l As Long)

    com.Parameters.Append com.CreateParameter(, 20, 1, , l)
End Sub

Public Sub AddIntegerParameter(ByVal i As Integer)

    com.Parameters.Append com.CreateParameter(, 3, 1, , i)
End Sub

Public Sub AddCharParameter(ByVal s As String)

    com.Parameters.Append com.CreateParameter(, 129, 1, , s)
End Sub

Public Function Execute(Optional ByVal result As Boolean = True) As Boolean

    On Error GoTo ErrorHandler
    
    Set rec = com.Execute
    
Finally:

    Execute = result
    Exit Function
    
ErrorHandler:

    result = False
    Call ShowError(Err)
    GoTo Finally
End Function

Public Sub Refresh()

    com.Parameters.Refresh
End Sub

Public Function GetRecordset() As Object

    Set GetRecordset = rec
End Function

Public Sub OutputToWorksheet(ByVal w As Worksheet)

    Dim i As Long, j As Long
    w.Cells.Clear
    rec.MoveFirst
    i = 1
    
    Do Until rec.EOF
    
        For j = 0 To rec.Fields.Count - 1
        
            If i = 1 Then w.Cells(i, j + 1) = rec(j).Name
            w.Cells(i + 1, j + 1) = rec(j).Value
        Next j
        
        rec.MoveNext
        i = i + 1
    Loop
End Sub

Public Sub ShowError(ByVal e As ErrObject)

    Dim s As String
    
    s = ""
    s = s & "ErrorNumber：" & CStr(e.Number) & ";" & vbCrLf
    s = s & "ErrorDescription：" & e.Description & ";" & vbCrLf
    s = s & "ErrorHelpFile：" & e.HelpFile & ";" & vbCrLf
    s = s & "ErrorHelpContext：" & e.HelpContext & ";"
    MsgBox s
End Sub

DbManagerと名付けて使用しているクラス。