Option Explicit

Private Const PROVIDER_ACCESS As String = "Microsoft.Ace.OLEDB.12.0"

Private sDBPath As String

'DBパス設定
Property Let DBPath(sPath As String)
    sDBPath = sPath
End Property

'テーブル情報の取得
Public Sub showTableInfo(Optional sTableName As String = "")
    
    Dim i As Long
    Dim adodbConn As ADODB.Connection
    Dim adoxCat As New ADOX.Catalog
    Dim adoxTable As ADOX.Table
    Dim adoxCol As New ADOX.Column
    
    '操作前処理
    Set adodbConn = beforeCtrl()
    
    'テーブル情報の取得
    adoxCat.ActiveConnection = adodbConn
    For Each adoxTable In adoxCat.Tables
        If adoxTable.Type = "TABLE" Then
            If (sTableName = "") Or (adoxTable.Name = sTableName) Then
                Debug.Print adoxTable.Name
                For Each adoxCol In adoxTable.Columns
                    Debug.Print vbTab & adoxCol.Name
                Next
            End If
        End If
    Next
    
    '操作後処理
    Call afterCtrl(adodbConn)
    
End Sub

'テーブルの作成
Public Sub createTable(sTableName As String)
    
    Dim i As Long
    Dim adodbConn As ADODB.Connection
    Dim adoxCat As New ADOX.Catalog
    Dim adoxTable As ADOX.Table
    
    '操作前処理
    Set adodbConn = beforeCtrl()
    
    'テーブルの作成
    adoxCat.ActiveConnection = adodbConn
    Set adoxTable = New ADOX.Table
    adoxTable.Name = sTableName
    Set adoxTable.ParentCatalog = adoxCat
    
    'カタログに追加
    Call adoxCat.Tables.Append(adoxTable)
    
    '操作後処理
    Call afterCtrl(adodbConn)
    
End Sub

'フィールドの追加
Public Sub addColumn(sTableName As String, arrayColumn() As Variant)
    
    Dim i As Long
    Dim adodbConn As ADODB.Connection
    Dim adoxCat As New ADOX.Catalog
    Dim adoxTable As ADOX.Table
    
    '操作前処理
    Set adodbConn = beforeCtrl()
    
    'フィールドの追加
    adoxCat.ActiveConnection = adodbConn
    Set adoxTable = adoxCat.Tables.Item(sTableName)
    With adoxTable.Columns
        For i = LBound(arrayColumn, 1) To UBound(arrayColumn, 1)
            Call .Append(arrayColumn(i, 0), arrayColumn(i, 1))
        Next
    End With
    
    '操作後処理
    Call afterCtrl(adodbConn)
    
End Sub

'フィールドの削除
Public Sub deleteColumn(sTableName As String, sColumnName As String)
    
    Dim adodbConn As ADODB.Connection
    Dim adoxCat As New ADOX.Catalog
    Dim adoxTable As ADOX.Table
    
    '操作前処理
    Set adodbConn = beforeCtrl()
    
    'フィールドの削除
    adoxCat.ActiveConnection = adodbConn
    Set adoxTable = adoxCat.Tables.Item(sTableName)
    Call adoxTable.Columns.Delete(sColumnName)
    
    '操作後処理
    Call afterCtrl(adodbConn)
    
End Sub

'テーブルの削除
Public Sub deleteTable(sTableName As String)
    
    Dim adodbConn As ADODB.Connection
    Dim adoxCat As New ADOX.Catalog
    
    '操作前処理
    Set adodbConn = beforeCtrl()
    
    'テーブルの削除
    adoxCat.ActiveConnection = adodbConn
    Call adoxCat.Tables.Delete(sTableName)
    
    '操作後処理
    Call afterCtrl(adodbConn)
    
End Sub

'操作前処理
Private Function beforeCtrl() As ADODB.Connection
    
    Dim sProvider As String
    Dim sDataSource As String
    Dim sConnection As String
    Dim adodbConn As New ADODB.Connection
    
    '情報収集
    sProvider = "Provider=" & PROVIDER_ACCESS & ";"
    sDataSource = "Data Source=" & sDBPath & ";"
    sConnection = sProvider & sDataSource
    
    'データベースへ接続
    Call adodbConn.Open(sProvider & sDataSource)
    
    '呼び出し元へ戻す
    Set beforeCtrl = adodbConn
    
End Function

'操作後処理
Private Sub afterCtrl(adodbConn As ADODB.Connection)
    
    'データベースを閉じる
    Call adodbConn.Close
    
    'Connectionを開放(破棄)
    Set adodbConn = Nothing
    
End Sub