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 2013 アイコン一覧(W)

    ・Office 2013 アイコン一覧 NUM…

  2. アイコン一覧

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

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

  3. Office関連

    Office製品のヘルプをHTML形式で閲覧する。

    「Word2013 VBA の日本語ヘルプ」で回答した通り、Offic…

  4. Office アドイン

    [Office用アプリ]RSS表示アプリを作成する。

    ※ この情報はOffice 2013 カスタマー プレビュー版を元にし…

  5. Office関連

    SkyDriveの同期フォルダーのパスを取得するマクロ

    前回の記事ではSkyDriveの同期フォルダーのパスを取得するWord…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP