Here is the complete code:
Public Class Connect
Implements Extensibility.IDTExtensibility2
Private _applicationObject As Object
Private _addInInstance As Object
Private WithEvents _outApp As Outlook.Application
Private WithEvents _ActiveExplorerBars As
Microsoft.Office.Core.CommandBars
Private WithEvents _conButton As
Microsoft.Office.Core.CommandBarButton
Private _IgnoreCommandbarsChanges As Boolean
Private _currentUser As String = String.Empty
Public Sub OnBeginShutdown(ByRef custom As System.Array)
Implements Extensibility.IDTExtensibility2.OnBeginShutdown
End Sub
Public Sub OnAddInsUpdate(ByRef custom As System.Array) Implements
Extensibility.IDTExtensibility2.OnAddInsUpdate
End Sub
Public Sub OnStartupComplete(ByRef custom As System.Array)
Implements Extensibility.IDTExtensibility2.OnStartupComplete
_outApp = DirectCast(_applicationObject, Outlook.Application)
_ActiveExplorerBars = _outApp.ActiveExplorer.CommandBars
Dim rUser As New Redemption.SafeCurrentUser
_currentUser = rUser.Name
Log("Startup." & _outApp.Name & " " & _outApp.ProductCode)
End Sub
Public Sub OnDisconnection(ByVal RemoveMode As
Extensibility.ext_DisconnectMode, ByRef custom As System.Array)
Implements Extensibility.IDTExtensibility2.OnDisconnection
End Sub
Public Sub OnConnection(ByVal application As Object, ByVal
connectMode As Extensibility.ext_ConnectMode, ByVal addInInst As
Object, ByRef custom As System.Array) Implements
Extensibility.IDTExtensibility2.OnConnection
Log("OnConnection")
_applicationObject = application
_addInInstance = addInInst
End Sub
'This fires when the user right-clicks a contact, and also for a
lot of other things!
Private Sub ActiveExplorerCBars_OnUpdate() Handles
_ActiveExplorerBars.OnUpdate
If _IgnoreCommandbarsChanges Then Exit Sub
If _ActiveExplorerBars.Item("Context Menu") IsNot Nothing Then
If _outApp.ActiveExplorer.Selection.Count > 0 Then
If _outApp.ActiveExplorer.Selection.Item(1).Class =
Outlook.OlObjectClass.olMail Then
AddContextButton(_ActiveExplorerBars.Item("Context
Menu"))
End If
End If
End If
End Sub
Private Sub AddContextButton(ByVal ContextMenu As
Microsoft.Office.Core.CommandBar)
Dim Control As Microsoft.Office.Core.CommandBarControl
Dim controlTag As String = "SalvaDocumentale"
'User cannot play with the Context Menu, so we know there is
at most only one copy of the control there
Control = ContextMenu.FindControl
(Type:=Microsoft.Office.Core.MsoControlType.msoControlButton,
Tag:=controlTag)
If Control Is Nothing Then
'Unprotect context menu
ChangingBar(ContextMenu, Restore:=False)
'Create the control
Control = ContextMenu.Controls.Add
(Type:=Microsoft.Office.Core.MsoControlType.msoControlButton)
''Set up control
Control.Tag = controlTag
Control.Caption = "Salva nel documentale..."
Control.Priority = 1
Control.Visible = True
'Reprotect context menu
ChangingBar(ContextMenu, Restore:=True)
'Hook the Click event
_conButton = DirectCast(Control,
Microsoft.Office.Core.CommandBarButton)
Else
Control.Priority = 1
End If
End Sub
'Called once to prepare for changes to the command bar, then again
with
'Restore = true once changes are complete.
Private Sub ChangingBar(ByVal bar As
Microsoft.Office.Core.CommandBar, ByVal Restore As Boolean)
Static oldProtectFromCustomize, oldIgnore As Boolean
If Restore Then
'Restore the Ignore Changes flag
_IgnoreCommandbarsChanges = oldIgnore
'Restore the protect-against-customization bit
If oldProtectFromCustomize Then bar.Protection = _
bar.Protection And
Microsoft.Office.Core.MsoBarProtection.msoBarNoCustomize
Else
'Store the old Ignore Changes flag
oldIgnore = _IgnoreCommandbarsChanges
'Store old protect-against-customization bit setting then
clear
'CAUTION: Be careful not to alter the property if there is
no need,
'as changing the Protection will cause any visible
CommandBarPopup
'to disappear unless it is the popup we are altering.
oldProtectFromCustomize = bar.Protection And
Microsoft.Office.Core.MsoBarProtection.msoBarNoCustomize
If oldProtectFromCustomize Then bar.Protection =
bar.Protection _
And Not
Microsoft.Office.Core.MsoBarProtection.msoBarNoCustomize
End If
End Sub
Private Sub ContextButton_Click(ByVal Ctrl As
Microsoft.Office.Core.CommandBarButton, ByRef CancelDefault As
Boolean) Handles _conButton.Click
Try
Dim email As Outlook.MailItem
Dim rEmail As New Redemption.SafeMailItem
Dim nrEmail As Integer =
_outApp.ActiveExplorer.Selection.Count
Dim emailSalvate As Integer = 0
Dim errori As String = String.Empty
Dim fileDir As String = System.IO.Path.GetTempPath() &
"SalvaEmailDocumentale"
Dim progArg As String = String.Empty
'Verifica esistenza directory di appoggio
Dim folderExists As Boolean
folderExists = My.Computer.FileSystem.DirectoryExists
(fileDir)
If Not folderExists Then
My.Computer.FileSystem.CreateDirectory(fileDir)
End If
'Processa le email
For i As Integer = 1 To nrEmail
Dim filePath As String = String.Empty
Dim dateCreation As String = String.Empty
Try
email = CType(_outApp.ActiveExplorer.Selection.Item
(i), Outlook.MailItem)
dateCreation = email.CreationTime.Year &
email.CreationTime.Month & email.CreationTime.Day &
email.CreationTime.Hour & email.CreationTime.Minute &
email.CreationTime.Second
filePath = fileDir & "\" & NormalizzaEmailFileName
(email.Subject) & "." & dateCreation & ".msg"
rEmail.Item = email
rEmail.SaveAs(filePath,
Outlook.OlSaveAsType.olMSG)
progArg &= Chr(34) & filePath & Chr(34) & " "
emailSalvate += 1
Catch ex As Exception
errori &= "Email: [" & filePath & "] Dettagli: " &
ex.Message & vbCrLf
End Try
Next
'Status
Dim messaggio As String
If errori.Length > 0 Then
messaggio = "Si è verificato almeno un errore nel
salvataggio temporaneo delle email. Contattare l'ufficio informatico."
& vbCrLf & errori
Log(messaggio)
MessageBox.Show(messaggio, My.Application.Info.Title,
MessageBoxButtons.OK, MessageBoxIcon.Error)
End If
If emailSalvate > 0 Then
'Esegue interfaccia documentale
Dim p As New Process
p.StartInfo.FileName = "\\pippo\pippo.exe"
p.StartInfo.Arguments = "E-mail"
p.StartInfo.Arguments &= " " & Chr(34) & fileDir & Chr
(34)
p.StartInfo.Arguments &= " " & progArg
p.Start()
'Al termine ripulisce cartella temporanea
p.WaitForExit()
My.Computer.FileSystem.DeleteDirectory(fileDir,
FileIO.DeleteDirectoryOption.DeleteAllContents)
End If
Catch ex As Exception
Log(ex.ToString)
End Try
End Sub
Private Function NormalizzaEmailFileName(ByVal name As String) As
String
name = Replace(name, "\", "")
name = Replace(name, "/", "")
name = Replace(name, ":", "")
name = Replace(name, "*", "")
name = Replace(name, "?", "")
name = Replace(name, """", "")
name = Replace(name, "<", "")
name = Replace(name, ">", "")
name = Replace(name, "|", "")
Return name
End Function
Private Sub Log(ByVal messaggio As String)
Dim fileLog As String = "\\pippo\pippo.log"
Try
messaggio = "[" & Now.ToString & "] [" & _currentUser & "]
" & messaggio & vbCrLf
My.Computer.FileSystem.WriteAllText(fileLog, messaggio,
True)
Catch ex As Exception
MessageBox.Show("Errore grave nel salvataggio log,
contattare l'ufficio informatico. Dettagli: " & ex.ToString,
My.Application.Info.Title, MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Sub
End Class
I developed an add-in to show a Context Menu on item right-click.
This was developed using Extensibility.IDTExtensibility2 interface in
Visual Studio, using the Microsoft Office 10.0 Library.
The add-in works fine on Office XP...any time I right-click an item,
it shows a context menu with an added button.
The weird thing happens on Office 2007... when I first right click the
context menu shows correctly. Then if I right-click immediately on
other items the menu doesn't always shows up with the added
button...instead if I wait at least three seconds between each right
click the context menu ALWAYS shows up correctly.
What could it be? I tried logging and debugging but I cannot solve the
issue.
Here I post a snippet of my code:
Private Sub ActiveExplorerCBars_OnUpdate() Handles
_ActiveExplorerBars.OnUpdate
If _IgnoreCommandbarsChanges Then Exit Sub
If _ActiveExplorerBars.Item("Context Menu") IsNot Nothing Then
If _outApp.ActiveExplorer.Selection.Count > 0 Then
If
...
leggi tutto- Nascondi testo citato
- Mostra testo citato -
