G
gdvrij
I'm building a contact export. I have a macro which checks if the
button exist, if not it create one else it's activate the button when a
contact is selected.
I run this macro manually, but I want to automatic run the macro when
anything is selected. Can anyone tell me how this is possible.
An other problem I have, when I deselect something the button must be
inactive. Like the standard button's in the outlook toolbar.
this is the macro:
Public Sub TMSButton()
Dim oButton As CommandBarControl
Dim objCommandbars As CommandBars
Dim objCommandBar As CommandBar
Dim objCommandBarControl As CommandBarControl
Dim chckExist As Boolean
Dim chckActiveWindow As Object
Dim button
Set objCommandbars = Outlook.ActiveExplorer.CommandBars
Set objCommandBar = objCommandbars.Item("Standard")
Set chckActiveWindow = GetCurrentItem()
chckExist = False
' Check if button exist
For Each objCommandBarControl In objCommandBar.Controls
If objCommandBarControl.Caption = "Export naar TMS" Then
objCommandBar.Controls.Item("Export naar TMS").Enabled =
False
objCommandBar.Controls.Item("Export naar TMS").TooltipText
= "http://tms.conclusion.nl/"
' activate button
If chckActiveWindow.Class = olContact Then
button = activateButton()
End If
chckExist = True
End If
Next objCommandBarControl
' Create button
If chckExist = False Then
button = createButton(chckActiveWindow)
End If
Set chckActiveWindow = Nothing
Set objBar = Nothing
End Sub
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = CreateObject("Outlook.Application")
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem =
objApp.ActiveExplorer.Selection.Item(1)
Case Else
' anything else will result in an error, which is
' why we have the error handler above
End Select
Set objApp = Nothing
End Function
Function createButton(chckActiveWindow)
Dim objButton As Office.CommandBarButton
Dim objBar As Office.CommandBar
Set objBar = ActiveExplorer.CommandBars("Standard")
If chckActiveWindow.Class = olContact Then
Set objButton = objBar.Controls.Add(msoControlButton)
With objButton
.Caption = "Export naar TMS"
.Tag = "TMS Export"
.HyperlinkType = msoCommandBarButtonHyperlinkOpen
.Visible = True
.TooltipText = "http://tms.conclusion.nl"
.Enabled = True
End With
Else
Set objButton = objBar.Controls.Add(msoControlButton)
With objButton
.Caption = "Export naar TMS"
.Tag = "TMS Export"
.HyperlinkType = msoCommandBarButtonHyperlinkOpen
.Visible = True
.TooltipText = "http://tms.conclusion.nl"
.Enabled = False
End With
End If
Set objButton = Nothing
End Function
Function activateButton()
Dim objCommandbars As CommandBars
Dim objCommandBar As CommandBar
Set objCommandbars = Outlook.ActiveExplorer.CommandBars
Set objCommandBar = objCommandbars.Item("Standard")
objCommandBar.Controls.Item("Export naar TMS").Enabled = True
objCommandBar.Controls.Item("Export naar TMS").TooltipText =
"http://tms.conclusion.nl/"
End Function
button exist, if not it create one else it's activate the button when a
contact is selected.
I run this macro manually, but I want to automatic run the macro when
anything is selected. Can anyone tell me how this is possible.
An other problem I have, when I deselect something the button must be
inactive. Like the standard button's in the outlook toolbar.
this is the macro:
Public Sub TMSButton()
Dim oButton As CommandBarControl
Dim objCommandbars As CommandBars
Dim objCommandBar As CommandBar
Dim objCommandBarControl As CommandBarControl
Dim chckExist As Boolean
Dim chckActiveWindow As Object
Dim button
Set objCommandbars = Outlook.ActiveExplorer.CommandBars
Set objCommandBar = objCommandbars.Item("Standard")
Set chckActiveWindow = GetCurrentItem()
chckExist = False
' Check if button exist
For Each objCommandBarControl In objCommandBar.Controls
If objCommandBarControl.Caption = "Export naar TMS" Then
objCommandBar.Controls.Item("Export naar TMS").Enabled =
False
objCommandBar.Controls.Item("Export naar TMS").TooltipText
= "http://tms.conclusion.nl/"
' activate button
If chckActiveWindow.Class = olContact Then
button = activateButton()
End If
chckExist = True
End If
Next objCommandBarControl
' Create button
If chckExist = False Then
button = createButton(chckActiveWindow)
End If
Set chckActiveWindow = Nothing
Set objBar = Nothing
End Sub
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = CreateObject("Outlook.Application")
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem =
objApp.ActiveExplorer.Selection.Item(1)
Case Else
' anything else will result in an error, which is
' why we have the error handler above
End Select
Set objApp = Nothing
End Function
Function createButton(chckActiveWindow)
Dim objButton As Office.CommandBarButton
Dim objBar As Office.CommandBar
Set objBar = ActiveExplorer.CommandBars("Standard")
If chckActiveWindow.Class = olContact Then
Set objButton = objBar.Controls.Add(msoControlButton)
With objButton
.Caption = "Export naar TMS"
.Tag = "TMS Export"
.HyperlinkType = msoCommandBarButtonHyperlinkOpen
.Visible = True
.TooltipText = "http://tms.conclusion.nl"
.Enabled = True
End With
Else
Set objButton = objBar.Controls.Add(msoControlButton)
With objButton
.Caption = "Export naar TMS"
.Tag = "TMS Export"
.HyperlinkType = msoCommandBarButtonHyperlinkOpen
.Visible = True
.TooltipText = "http://tms.conclusion.nl"
.Enabled = False
End With
End If
Set objButton = Nothing
End Function
Function activateButton()
Dim objCommandbars As CommandBars
Dim objCommandBar As CommandBar
Set objCommandbars = Outlook.ActiveExplorer.CommandBars
Set objCommandBar = objCommandbars.Item("Standard")
objCommandBar.Controls.Item("Export naar TMS").Enabled = True
objCommandBar.Controls.Item("Export naar TMS").TooltipText =
"http://tms.conclusion.nl/"
End Function