Outlook özel menü düğmeleri

Question

Yardım menüsünden sonra görünüm menüsünde eklenmesini istediğim 2 menü düğmesi var. Düğmeleri eklemek için kod yaptım ama 2 menü düğmeleri zaten varsa bile görünüm yeniden reopen her zaman 2 daha fazla düğme ekler. Herhangi bir yardım bekliyor.

Function ToolBarExists(strName As String) As Boolean 
Dim tlbar As commandBar 
    For Each tlbar In ActiveExplorer.CommandBars 
    If tlbar.Name = strName Then 
     ToolBarExists = True 
     Exit For 
    End If 
Next tlbar 
End Function 

Sub TBarExistsbutton1() 
    If ToolBarExists("button1") Then 
     If ActiveExplorer.CommandBars("button1").Visible = True Then 
      ActiveExplorer.CommandBars("button1").Visible = False 
     Else 
      ActiveExplorer.CommandBars("button1").Visible = True 
     End If 
    Else 
     Call a123 
    End If 

End Sub 
Sub TBarExistsbutton2() 
    If ToolBarExists("button2") Then 
     If ActiveExplorer.CommandBars("button2").Visible = True Then 
      ActiveExplorer.CommandBars("button2").Visible = False 
     Else 
      ActiveExplorer.CommandBars("button2").Visible = True 
     End If 
    Else 
     Call a1234 
    End If 
    End Sub 

Sub a123() 
Dim outl As Object 
Dim msg As Object 
Set outl = CreateObject("Outlook.Application") 
Dim objBar As Office.commandBar 
Dim objButton As Office.commandBarButton 
Set objBar = Application.ActiveWindow.CommandBars("Menu Bar") 
Set objButton = objBar.Controls.Add(msoControlButton) 
    With objButton 
    .caption = "button1" 
    .onAction = "macro1" 
    .faceId = 487 
    .Style = msoButtonIconAndCaption 
End With 
End Sub 

Sub a1234() 
Dim outl As Object 
Dim msg As Object 
Set outl = CreateObject("Outlook.Application") 
Dim objBar As Office.commandBar 
Dim objButton As Office.commandBarButton 
Set objBar = Application.ActiveWindow.CommandBars("Menu Bar") 
Set objButton = objBar.Controls.Add(msoControlButton) 
With objButton 
    .caption = "button2" 
    .onAction = "macro2" 
    .faceId = 487 
    .Style = msoButtonIconAndCaption 
End With 
End Sub 

Answer 1

Outlook 2010'da. Görünür çalışıyorsa, benzer bir şekilde dahil edin.

Option Explicit 

Sub TBarExistsbutton1() 

    Dim cbControlCount As Long 
    Dim button1Found As Boolean 
    Dim j As Long 

    If ToolBarExists("Menu Bar") Then 

     cbControlCount = ActiveWindow.CommandBars("Menu Bar").Controls.count 
     Debug.Print " There are " & cbControlCount & " controls in " & "Menu Bar" 

     For j = 1 To cbControlCount 
      Debug.Print ActiveWindow.CommandBars("Menu Bar").Controls(j).Caption 
      If ActiveWindow.CommandBars("Menu Bar").Controls(j).Caption = "button1" Then 
       button1Found = True 
       Exit For 
      End If 
     Next j 

     If button1Found = False Then a123 

    Else 
     Debug.Print "Menu Bar does not exist." 
     a123 

    End If 

End Sub