データベースの最適化ボタンをクリックする

Access VBA

'###########################################################################################
'  ClickCompactAndRepair
'
'  データベースの最適化ボタンをクリック
'
'  引数:無し
'
'  戻り値:無し
'
'  備考:参照設定にてUIAutomationClientにチェックすること
'       Access2013にて動作確認(他のバージョンではボタンの配置が異なる可能性が有る)
'
'  参考
'    Access本体からデータベースの最適化ボタンまでのオブジェクトのツリー構造
'
'    OMain
'        MsoCommandBarDock
'            MsoCommandbar
'                MsoWorkPane
'                    NUIPane
'                        NetUIHWNDElement
'                            NetUInetpane
'                                NetUIPanViewer                   リボン タブ
'                                    NetUIRibbonTab               データベース ツール
'                                NetUIPanViewer                   下リボン
'                                    NetUIOrderedGroup            データベース ツール
'                                        NetUIChunk               ツール
'                                            NetUIRibbonButton    データベースの最適化 / 修復
'
'###########################################################################################
Sub ClickCompactAndRepair()
    
    Dim cAuto As CUIAutomation
    Dim eRoot As IUIAutomationElement
    Dim elem1 As IUIAutomationElement
    Dim elem2 As IUIAutomationElement
    Dim elem3 As IUIAutomationElement
    Dim elem4 As IUIAutomationElement
    
    Dim cond1 As IUIAutomationCondition
    Dim cond2 As IUIAutomationCondition
    Dim cond3 As IUIAutomationCondition
    
    Dim patSl As IUIAutomationSelectionItemPattern
    Dim patIv As IUIAutomationInvokePattern
    
    Set cAuto = New CUIAutomation
    Set eRoot = cAuto.GetRootElement
    
    'Access本体
    Set cond1 = cAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "OMain")
    Set elem1 = eRoot.FindFirst(TreeScope_Children, cond1)
    
    Set cond1 = cAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "MsoCommandBarDock")
    Set elem1 = elem1.FindFirst(TreeScope_Children, cond1)
    
    Set cond1 = cAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "MsoCommandBar")
    Set elem1 = elem1.FindFirst(TreeScope_Children, cond1)
    
    Set cond1 = cAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "MsoWorkPane")
    Set elem1 = elem1.FindFirst(TreeScope_Children, cond1)
    
    Set cond1 = cAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "NUIPane")
    Set elem1 = elem1.FindFirst(TreeScope_Children, cond1)
    
    Set cond1 = cAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "NetUIHWNDElement")
    Set elem1 = elem1.FindFirst(TreeScope_Children, cond1)
    
    'リボンと下リボンの親
    Set cond1 = cAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "NetUInetpane")
    Set elem1 = elem1.FindFirst(TreeScope_Children, cond1)
    
    'リボン
    Set cond1 = cAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "NetUIPanViewer")
    Set cond2 = cAuto.CreatePropertyCondition(UIA_NamePropertyId, "リボン タブ")
    Set cond3 = cAuto.CreateAndCondition(cond1, cond2)
    Set elem2 = elem1.FindFirst(TreeScope_Children, cond3)
    
    'データベースツールタブ
    Set cond1 = cAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "NetUIRibbonTab")
    Set cond2 = cAuto.CreatePropertyCondition(UIA_NamePropertyId, "データベース ツール")
    Set cond3 = cAuto.CreateAndCondition(cond1, cond2)
    Set elem2 = elem2.FindFirst(TreeScope_Children, cond3)
    
    '下リボン
    Set cond1 = cAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "NetUIPanViewer")
    Set cond2 = cAuto.CreatePropertyCondition(UIA_NamePropertyId, "下リボン")
    Set cond3 = cAuto.CreateAndCondition(cond1, cond2)
    Set elem3 = elem1.FindFirst(TreeScope_Children, cond3)
    
    'データベースツールの実体(データベースツールタブが選択されていたら下リボンの下に存在する)
    Set cond1 = cAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "NetUIOrderedGroup")
    Set cond2 = cAuto.CreatePropertyCondition(UIA_NamePropertyId, "データベース ツール")
    Set cond3 = cAuto.CreateAndCondition(cond1, cond2)
    Set elem4 = elem3.FindFirst(TreeScope_Children, cond3)
    
    '下リボンの下にデータベースツールの実体が存在しなかったらデータベースツールタブを選択してから
    'データベースツールの実体を取得する。
    If elem4 Is Nothing Then
        Set patSl = elem2.GetCurrentPattern(UIA_SelectionItemPatternId)
        patSl.Select
    
        Set cond1 = cAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "NetUIOrderedGroup")
        Set cond2 = cAuto.CreatePropertyCondition(UIA_NamePropertyId, "データベース ツール")
        Set cond3 = cAuto.CreateAndCondition(cond1, cond2)
        Set elem4 = elem3.FindFirst(TreeScope_Children, cond3)
    End If

    Set cond1 = cAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "NetUIChunk")
    Set cond2 = cAuto.CreatePropertyCondition(UIA_NamePropertyId, "ツール")
    Set cond3 = cAuto.CreateAndCondition(cond1, cond2)
    Set elem4 = elem4.FindFirst(TreeScope_Children, cond3)
    
    Set cond1 = cAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "NetUIRibbonButton")
    Set cond2 = cAuto.CreatePropertyCondition(UIA_NamePropertyId, "データベースの最適化/修復")
    Set cond3 = cAuto.CreateAndCondition(cond1, cond2)
    Set elem4 = elem4.FindFirst(TreeScope_Children, cond3)
    
    'DoCmd.SetWarnings False
    Set patIv = elem4.GetCurrentPattern(UIA_InvokePatternId)
    patIv.Invoke
    'DoCmd.SetWarnings True
    
End Sub