我在我的VbaProject.OTM文件的 ThisOutlookSession 中使用以下内容,将2个自定义按钮添加到新邮件的标准工具栏中:
Dim outl As Object
Dim msg As Object
Set outl = CreateObject("Outlook.Application")
Set msg = outl.CreateItem(0)
msg.Display (False)
Dim objBar As Office.CommandBar
Dim objButton As Office.CommandBarButton
Set objBar = Application.ActiveWindow.CommandBars("Standard")
Set objButton = objBar.Controls.Add(msoControlButton)
With objButton
.caption = "button1"
.OnAction = "macro1"
.TooltipText = "Description"
.faceId = 487
.Style = msoButtonIconAndCaption
.BeginGroup = True
End With
Set objButton = objBar.Controls.Add(msoControlButton)
With objButton
.caption = "button2"
.OnAction = "macro2"
.TooltipText = "Description"
.faceId = 2525
.Style = msoButtonIconAndCaption
.BeginGroup = True
End With
msg.Close 1
问题是每次Outlook启动时都会添加按钮(这是我愿意将我的OTM文件部署到的其他计算机所需的)。在添加按钮之前有没有办法检查它是否已经存在?
答案 0 :(得分:2)
您的按钮是toolbar
的一部分。因此检查工具栏是否存在。
If IsToolbar("Standard") Then
'-- do something
Else
'-- create tool bar and add the buttons
End If
或试试这个:
For Each Contrl in Application.CommandBars("Standard").Controls
If .Caption <> "button1" then
'-- create it
End If
Next Contrl
因此,让我们坚持捕捉错误...(未经测试的代码,因此您可能需要尝试一下以获得完全正确的语法)
Dim ctlCBarControl As CommandBarControl
On Error Resume Next
Set ctlCBarControl = Application.CommandBars("Standard").Controls("button1")
If Err <> 0 Then
'-- no button exists, you may add it
Err = 0
Else
'-- the button is there..
End If
End if