Office関連

指定したAccessファイルで「データベースの最適化/修復」を実行するVBAマクロ

大分前の記事になりますが、開いているデータベースを最適化するマクロのコードを下記ページで公開しています。

気が向いたので、今回改めてデータベースの最適化と修復を行うマクロを書いてみることにしました。

'UIAutomationClient(UIAutomationCore.dll)要参照
Option Explicit

Public Sub Sample()
  CompactAndRepairDatabase "C:\Test\TestDB.accdb"
End Sub

Private Sub CompactAndRepairDatabase(ByVal DBPath As String)
'[データベースの最適化/修復]を実行
  Dim uiAuto As CUIAutomation
  Dim accRibbon As IAccessible
  Dim elmRibbon As IUIAutomationElement
  Dim elmRibbonTab As IUIAutomationElement
  Dim elmDBRepairButton As IUIAutomationElement
  Dim ptnSel As IUIAutomationSelectionItemPattern
  Dim ptnInvoke As IUIAutomationInvokePattern
  
  Set uiAuto = New UIAutomationClient.CUIAutomation
  With CreateObject("Access.Application")
    .Visible = True
    .OpenCurrentDatabase DBPath
    
    '[データベース ツール]タブ選択
    Set accRibbon = .CommandBars("Ribbon")
    Set elmRibbon = uiAuto.ElementFromIAccessible(accRibbon, 0)
    Set elmRibbonTab = GetElement(uiAuto, _
                                  elmRibbon, _
                                  UIA_NamePropertyId, _
                                  "データベース ツール", _
                                  UIA_TabItemControlTypeId)
    If elmRibbonTab Is Nothing Then GoTo Fin
    Set ptnSel = elmRibbonTab.GetCurrentPattern(UIA_SelectionItemPatternId)
    ptnSel.Select
    
    '[データベースの最適化/修復]ボタンクリック
    Set elmDBRepairButton = GetElement(uiAuto, _
                                       elmRibbon, _
                                       UIA_NamePropertyId, _
                                       "データベースの最適化/修復", _
                                       UIA_ButtonControlTypeId)
    If elmDBRepairButton Is Nothing Then GoTo Fin
    Set ptnInvoke = elmDBRepairButton.GetCurrentPattern(UIA_InvokePatternId)
    ptnInvoke.Invoke
Fin:
    .CloseCurrentDatabase
    .Quit
  End With
End Sub

Private Function GetElement(ByVal uiAuto As CUIAutomation, _
                            ByVal elmParent As IUIAutomationElement, _
                            ByVal propertyId As Long, _
                            ByVal propertyValue As Variant, _
                            Optional ByVal ctrlType As Long = 0) As IUIAutomationElement
  Dim cndFirst As IUIAutomationCondition
  Dim cndSecond As IUIAutomationCondition
     
  Set cndFirst = uiAuto.CreatePropertyCondition( _
                   propertyId, _
                   propertyValue _
                 )
  If ctrlType <> 0 Then
    Set cndSecond = uiAuto.CreatePropertyCondition( _
                      UIA_ControlTypePropertyId, _
                      ctrlType _
                    )
    Set cndFirst = uiAuto.CreateAndCondition( _
                     cndFirst, _
                     cndSecond _
                   )
  End If
  Set GetElement = elmParent.FindFirst(TreeScope_Subtree, cndFirst)
End Function

仕組みとしては、UI Automationを使って、

[データベース ツールタブ]を選択

[データベースの最適化/修復]ボタンをクリック

といった操作を行うもので、Access上で開いているデータベース自身を最適化するのではなく、外部(Excel等)から複数のファイルを連続して最適化することを目的としています。

需要があるかどうかは分かりませんが、どなたかのご参考になれば幸いです。
ちなみに、タブやボタンの配置、名前に依存したコードですので、今後のAccessのバージョンアップによっては動作しなくなる可能性がある点についてはご注意ください。

オマケ

今回のコードを書くにあたり、ExecuteMsoメソッドを使って開いているデータベースの最適化ができるかどうかのテストもしてみました。

Private Sub Test()
  Application.CommandBars.ExecuteMso "FileCompactAndRepairDatabase"
End Sub

案の定実行できなかったのですが、表示されたメッセージが下図です。

マクロまたは Visual Basic コードを実行して、開いているデータベースを最適化することはできません。

マクロまたはコードを使用する代わりに、[ファイル] タブをクリックし、[データベースの最適化/修復] をクリックしてください。

といったメッセージが表示されているはずなのですが、文字が重なっているので全然読めませんね😅

仕様というか、バグというか、何れにせよあまり見る機会は無さそうなメッセージボックスです。気が向いたらMicrosoftにフィードバックしておきます。

2019/8/15 追記:
Tech Communityでフィードバック後、気が付いたら問題のメッセージは修正されていました。

関連記事

  1. Office関連

    [リボン・カスタマイズ]splitButton要素で大量にある項目を使いやすくまとめる。

    「既存の機能の代わりにマクロを実行する」でコメント(下記)をいただきま…

  2. Office関連

    ヘッドレス ChromeをSeleniumBasicで動かしてみました。

    Chromeがヘッドレスモードに対応した頃、Seleniumで操作した…

  3. Office アドイン

    Office 2016で進化したOffice アドイン

    今日OfficeDevを眺めていて気が付いたのが「OfficeJS S…

  4. Office関連

    選択範囲をOneNoteに送るVBAマクロ

    OneNote プリンタードライバー(プリンター)を使ってドキュメント…

  5. Office アドイン

    office-toolboxを使って簡単にOffice アドインを作成する方法

    以前「YO OFFICE」を使ってOffice アドインのひな型を作成…

  6. Office関連

    VBAでTTSエンジンの各種情報を列挙する

    今回はTTSエンジンの各種情報を列挙するマクロを紹介します。Mic…

コメント

  • コメント (0)

  • トラックバックは利用できません。

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP