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でフィードバック後、気が付いたら問題のメッセージは修正されていました。

2019年7月の人気記事前のページ

[Google Apps Script]スプレッドシートで不要な空白文字を削除する次のページ

関連記事

  1. Office アドイン

    [Officeアドイン]テーブルやグラフを作成する方法(Excel)

    お久しぶりのOffice アドインの記事です。注目している人はほと…

  2. Office アドイン

    [Office用アプリ]画像を挿入する。

    DocumentオブジェクトのsetSelectedDataAsync…

  3. Office関連

    [Excel Services ECMAScript]ループによる入力と一括入力の処理時間について

    埋め込んだExcelワークブックのセルに対して、ループで1セルずつ入力…

  4. Office関連

    VBAからRegistration-Freeで.NETベースのDLLを呼び出す方法

    C#製のDLLをVBAから呼び出すのにいちいちRegAsmするのも面倒…

  5. Office関連

    Excel REST APIをPowerShellから呼び出す方法

    以前Excel REST APIをVBAから呼び出す方法を紹介しました…

  6. Office関連

    “元に戻す”履歴に文字列をセットするPowerPointマクロ

    PowerPointマクロでは、Presentationオブジェクトの…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

Translate

Chinese (Simplified)Chinese (Traditional)EnglishFrenchGermanJapaneseKoreanRussianSpanish

最近の記事

アーカイブ

PAGE TOP