T
Tometa
Hi!
I created custom button in ThisOutlookSession module, but it works only in
first instance of Outlook. If I open another instances it does not work
there, only in the first. Is there any way to enable it?
Part of code is:
Dim WithEvents objLinkedCommandBarButton1 As Office.CommandBarButton
Dim myOlApp As New Outlook.Application
Dim myNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Private Sub Application_Startup()
CreateCustomButtonWithEventHook
objLinkedCommandBarButton1.State = msoButtonUp
End Sub
Sub CreateCustomButtonWithEventHook()
On Error Resume Next
Dim objCB As Office.CommandBar
Dim objCBB As Office.CommandBarButton
Dim objCBP As Office.CommandBarPopup
Set objCB = Application.ActiveExplorer.CommandBars("Dodatno")
Set objCBP = objCB.Controls.Item("Mape")
If objCBP Is Nothing Then
'The commandbar Popup doesn't exist, create
Set objCBP =
objCB.Controls.Add(MsoControlType.msoControlButtonPopup, , , , False)
With objCBP
.Caption = "Map&e"
.TooltipText = "Otvara odabranu mapu."
End With
End If
'Retrieve a previously created custom commandbar button
'Arhivska mapa
Set objCBB = objCBP.Controls.Item("&Arhiva")
If objCBB Is Nothing Then
'The commandbar button doesn't exist, create
Set objCBB = objCBP.Controls.Add(MsoControlType.msoControlButton, ,
, , False)
With objCBB
.Caption = "&Arhiva"
.TooltipText = "Otvara arhivsku mapu."
.State = msoButtonUp
End With
End If
Set objLinkedCommandBarButton1 = objCBB
End Sub
Private Sub objLinkedCommandBarButton1_Click(ByVal Ctrl As
Office.CommandBarButton, CancelDefault As Boolean)
Set myNS = myOlApp.GetNamespace("MAPI")
Set myExplorer = myOlApp.ActiveExplorer
If objLinkedCommandBarButton1.State = msoButtonDown Then
objLinkedCommandBarButton1.State = msoButtonUp
Set objFolder = myNS.Folders.Item("Item")
myNS.RemoveStore objFolder
Set objFolder = myNS.Folders.Item("Item")
myExplorer.SelectFolder objFolder
Else
objLinkedCommandBarButton1.State = msoButtonDown
On Error GoTo ErrorHandler
myNS.AddStore "path"
Set objFolder = myNS.Folders.Item("Item")
myExplorer.SelectFolder objFolder.Folders("Inbox")
End If
Exit Sub
ErrorHandler:
MsgBox "msg"
End Sub
I created custom button in ThisOutlookSession module, but it works only in
first instance of Outlook. If I open another instances it does not work
there, only in the first. Is there any way to enable it?
Part of code is:
Dim WithEvents objLinkedCommandBarButton1 As Office.CommandBarButton
Dim myOlApp As New Outlook.Application
Dim myNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Private Sub Application_Startup()
CreateCustomButtonWithEventHook
objLinkedCommandBarButton1.State = msoButtonUp
End Sub
Sub CreateCustomButtonWithEventHook()
On Error Resume Next
Dim objCB As Office.CommandBar
Dim objCBB As Office.CommandBarButton
Dim objCBP As Office.CommandBarPopup
Set objCB = Application.ActiveExplorer.CommandBars("Dodatno")
Set objCBP = objCB.Controls.Item("Mape")
If objCBP Is Nothing Then
'The commandbar Popup doesn't exist, create
Set objCBP =
objCB.Controls.Add(MsoControlType.msoControlButtonPopup, , , , False)
With objCBP
.Caption = "Map&e"
.TooltipText = "Otvara odabranu mapu."
End With
End If
'Retrieve a previously created custom commandbar button
'Arhivska mapa
Set objCBB = objCBP.Controls.Item("&Arhiva")
If objCBB Is Nothing Then
'The commandbar button doesn't exist, create
Set objCBB = objCBP.Controls.Add(MsoControlType.msoControlButton, ,
, , False)
With objCBB
.Caption = "&Arhiva"
.TooltipText = "Otvara arhivsku mapu."
.State = msoButtonUp
End With
End If
Set objLinkedCommandBarButton1 = objCBB
End Sub
Private Sub objLinkedCommandBarButton1_Click(ByVal Ctrl As
Office.CommandBarButton, CancelDefault As Boolean)
Set myNS = myOlApp.GetNamespace("MAPI")
Set myExplorer = myOlApp.ActiveExplorer
If objLinkedCommandBarButton1.State = msoButtonDown Then
objLinkedCommandBarButton1.State = msoButtonUp
Set objFolder = myNS.Folders.Item("Item")
myNS.RemoveStore objFolder
Set objFolder = myNS.Folders.Item("Item")
myExplorer.SelectFolder objFolder
Else
objLinkedCommandBarButton1.State = msoButtonDown
On Error GoTo ErrorHandler
myNS.AddStore "path"
Set objFolder = myNS.Folders.Item("Item")
myExplorer.SelectFolder objFolder.Folders("Inbox")
End If
Exit Sub
ErrorHandler:
MsgBox "msg"
End Sub