access2010 VSTOアプリケーションアドイン -9-

データベースプロパティについて考えてみようかな。

例えば、AllowBypassKeyとか。いちいちコードを書くとかコピペするのをやめてもいいかなと。VBAのコードをそのまま移植する場合、TryしてCOMExceptionをCatchって感じなのだろうけど、へそ曲がりなのとLINQ to Objectがなんだか面白いのでちょっとあれこれ。

Imports DAO = Microsoft.Office.Interop.Access.Dao
Friend Class DBProperties

    Friend Shared Property AllowBypassKey As Boolean
        Get
            If ExistProperty("AllowBypassKey") Then
                Return CBool(GetProperty("AllowBypassKey"))
            Else
                Return True
            End If
        End Get
        Set(value As Boolean)
            If value Then
                DeleteProperty("AllowBypassKey")
            Else
                SetProperty("AllowBypassKey", value)
            End If
        End Set
    End Property

    Private Shared Function ExistProperty(PropertyName As String) As Boolean
        Dim dbs As DAO.Database =
            Globals.ThisAddIn.Application.CurrentDb
        Try
            Return dbs.Properties.Cast(Of DAO.Property).
                Any(Function(n) n.Name = PropertyName)
        Finally
            dbs.Close()
        End Try
    End Function

    Private Overloads Shared Sub SetProperty(PropertyName As String,
                                             PropertyValue As Boolean)
        Dim dbs As DAO.Database =
            Globals.ThisAddIn.Application.CurrentDb
        Try
            If ExistProperty(PropertyName) Then
                dbs.Properties(PropertyName).Value = PropertyValue
            Else
                Dim dbProperty As DAO.Property =
                    dbs.CreateProperty(PropertyName,
                                       DAO.DataTypeEnum.dbBoolean,
                                       PropertyValue)
                dbs.Properties.Append(dbProperty)
            End If
        Finally
            dbs.Close()
        End Try
    End Sub

    Private Overloads Shared Sub SetProperty(Propertyname As String,
                                             PropertyValue As Integer)
        Dim dbs As DAO.Database =
            Globals.ThisAddIn.Application.CurrentDb
        Try
            If ExistProperty(Propertyname) Then
                dbs.Properties(Propertyname).Value = PropertyValue
            Else
                Dim dbProperty As DAO.Property =
                    dbs.CreateProperty(Propertyname,
                                       DAO.DataTypeEnum.dbLong,
                                       PropertyValue)
                dbs.Properties.Append(dbProperty)
            End If
        Finally
            dbs.Close()
        End Try
    End Sub

    Private Overloads Shared Sub SetProperty(Propertyname As String,
                                             PropertyValue As String)
        Dim dbs As DAO.Database =
            Globals.ThisAddIn.Application.CurrentDb
        Try
            If ExistProperty(Propertyname) Then
                dbs.Properties(Propertyname).Value = PropertyValue
            Else
                Dim dbProperty As DAO.Property =
                    dbs.CreateProperty(Propertyname,
                                       DAO.DataTypeEnum.dbText,
                                       PropertyValue)
                dbs.Properties.Append(dbProperty)
            End If
        Finally
            dbs.Close()
        End Try
    End Sub

    Private Shared Function GetProperty(PropertyName As String) As Object
        Dim dbs As Access.Dao.Database =
            Globals.ThisAddIn.Application.CurrentDb
        Try
            Return dbs.Properties(PropertyName).Value
        Finally
            dbs.Close()
        End Try
    End Function

    Private Shared Sub DeleteProperty(PropertyName As String)
        Dim dbs As Access.Dao.Database =
            Globals.ThisAddIn.Application.CurrentDb
        Try
            If ExistProperty(PropertyName) Then
                dbs.Properties.Delete(PropertyName)
            End If
        Finally
            dbs.Close()
        End Try
    End Sub

End Class

とりあえず作動するからいいかと思いつつも、検討はそのうちに。
さらに考え中

Imports System.Windows.Forms
Imports DAO = Microsoft.Office.Interop.Access.Dao
Public Class DBProperties

    Private dbs As DAO.Database
    Private _IsDBOpen As Boolean

    Sub New()
        If Globals.ThisAddIn.Application.CurrentProject.FullName = "" Then
            Dim ofd As New OpenFileDialog
            ofd.Title = "ファイル選択"
            ofd.InitialDirectory = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments)
            ofd.Filter = "Accessファイル(*.accdb;*.accde;*.mdb;*.mde)|*.accdb;*.accde;*.mdb;*.mde|すべてのファイル(*.*)|*.*"
            If ofd.ShowDialog = DialogResult.OK Then
                dbs = Globals.ThisAddIn.Application.DBEngine.Workspaces(0).OpenDatabase(ofd.FileName)
            End If
        Else
            dbs = Globals.ThisAddIn.Application.CurrentDb
        End If
        _IsDBOpen = Not dbs Is Nothing
    End Sub

    Public ReadOnly Property IsDBOpen As Boolean
        Get
            Return _IsDBOpen
        End Get
    End Property

    Public Property AllowBypassKey As Boolean
        Get
            If ExistProperty("AllowBypassKey") Then
                Return CBool(dbs.Properties("AllowBypassKey").Value)
            Else
                Return True
            End If
        End Get
        Set(value As Boolean)
            If value Then
                DeleteProperty("AllowBypassKey")
            Else
                CreateProperty("AllowBypassKey", False)
            End If
        End Set
    End Property

    Private Function ExistProperty(PropertyName As String) As Boolean
        Return dbs.Properties.Cast(Of DAO.Property).Any(Function(p) p.Name = PropertyName)
    End Function

    Private Sub DeleteProperty(PropertyName As String)
        If ExistProperty(PropertyName) Then
            dbs.Properties.Delete(PropertyName)
        End If
    End Sub

    Private Sub CreateProperty(PropertyName As String, PropertyValue As Boolean)
        If ExistProperty(PropertyName) Then
            dbs.Properties(PropertyName).Value = PropertyValue
        Else
            Dim Prp As DAO.Property = dbs.CreateProperty(PropertyName, DAO.DataTypeEnum.dbBoolean, PropertyValue)
            dbs.Properties.Append(Prp)
        End If
    End Sub
End Class