asked on
Const msoControlButton = 1
Const msoCommandBarButtonHyperlinkOpen = 1
'Change the toolbar name on the next line as desired.'
Const CMDBAR_TITLE = "Service Desk Bar"
Dim objItem ' As Outlook.ContactItem
Dim objFD ' As Outlook.FormDescription
Dim fso ' As FileSystemObject
Dim olkApp, olkSes, ofcBar, ofcButton
Set olkApp = CreateObject("Outlook.Application") ' As Outlook.Application
Set olkSes = olkApp.GetNamespace("MAPI")
'Change the profile name on the next line as needed.'
olkSes.Logon "Outlook"
'Add custom Form
Set fso = CreateObject("Scripting.FileSystemObject")
CurrentDirectory = fso.BuildPath(fso.GetAbsolutePathName("."), "Teste1.oft")
Set objItem = olkApp.CreateItemFromTemplate(CurrentDirectory)
Set objFD = objItem.FormDescription
With objFD
.DisplayName = "TemplateServiceDesk"
.PublishForm olPersonalRegistry
End With
objItem.Close olDiscard
On Error Resume Next
'Clear any bars
Set ofcBar = olkApp.ActiveExplorer.CommandBars.Item(CMDBAR_TITLE)
If TypeName(ofcBar) <> "Nothing" Then
ofcBar.Delete
End If
'New bar
Set ofcBar = olkApp.ActiveExplorer.CommandBars.Add(CMDBAR_TITLE)
With ofcBar
.Visible = True
End With
'Set Button
Set ofcButton = ofcBar.Controls.Add(msoControlButton)
With ofcButton
'Change the caption on the next line.'
.Caption = "ABRIR Chamado Service Desk"
.HyperlinkType = msoCommandBarButtonHyperlinkOpen
'Change the path to the template file on the next line.'
.TooltipText = "" 'I DON'T KNOW WHAT TO PUT HERE
.Visible = True
End With
olkSes.Logoff
Set olkSes = Nothing
Set olkApp = Nothing
Set ofcButton = Nothing
Set ofcPopup = Nothing
Set ofcBar = Nothing
Set objFD = Nothing
Set objItem = Nothing
Set fso = Nothing