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用アプリ]日経パソコン 2013/8/26号 の記事

    日経パソコン 2013/8/26号 のニュース&トレンドにOffice…

  2. Office関連

    [Outlook]仕分けルールでスクリプト(マクロ)を実行する。

    Msdn フォーラムにあった質問関連でメモを残しておきます。…

  3. アイコン一覧

    Office 365アイコン(imageMso)一覧(C)

    Office 365のデスクトップ版Officeアプリケーション(Wo…

  4. Office関連

    [Excel Services ECMAScript]ActiveWorkbookのパスを取得する。…

    埋め込んだExcelワークブックのパスを取得するコードです。 (さ…

  5. Office関連

    関数一覧(Excel 2013 Customer Preview)

    関数の挿入ダイアログから抽出したExcel 2013 Customer…

  6. Office関連

    jQuery UIのDatepickerをVBAから使用するサンプル

    2014/1/31 追記:Internet Explorerのオー…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

PAGE TOP