Option Explicit On Imports Microsoft.Office.Interop Imports System.Reflection Imports System.Windows.Forms Imports Microsoft.Office.Core Imports System.Dynamic Imports SDL 'Option Private Module 'Imports Microsoft.Office.Core Public Class ThisAddIn Private WithEvents inspectors As Outlook.Inspectors Private WithEvents Items As Outlook.Items Private WithEvents currentExplorer As Outlook.Explorer Public Shared WithEvents SharedExplorer As Outlook.Explorer Public Shared WithEvents SelectedMail As Outlook.MailItem Public Shared WithEvents MapiPath As Outlook.MAPIFolder Public Shared MailOpened As Boolean = False Public Shared WithEvents oufolder As Outlook.Folder ' Dim fldr As Outlook.Folder 'Dim mapifldr As Outlook.MAPIFolder Private Sub ThisAddIn_Startup(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Startup inspectors = Me.Application.Inspectors currentExplorer = Me.Application.ActiveExplorer SharedExplorer = currentExplorer checkConnection() AddHandler VERAGRibbon.bla, Sub() ' MsgBox("JOAS") TestPrintFirstPage() End Sub AddHandler rbnMailItem.bla, Sub() ' MsgBox("JOAS") ' TestPrintFirstPage() End Sub End Sub Private APP = Me.Application Public Shared Sub Folder_BeforeItemMove(ByVal anItem As Object, ByVal aMoveToFolder As Outlook.MAPIFolder, ByRef Cancel As Boolean) Handles oufolder.BeforeItemMove Dim mailItem As Outlook.MailItem = (TryCast(anItem, Outlook.MailItem)) MailChanged(Nothing, mailItem, "verschoben nach " & aMoveToFolder.FullFolderPath.ToString & " von: ") End Sub Private Sub CurrentExplorer_Event() Handles currentExplorer.SelectionChange 'Dim oldmailitem As Outlook.MailItem = SelectedMail ' mapifldr = Application.Session.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox) Dim selectedFolder As Outlook.MAPIFolder = Me.Application.ActiveExplorer().CurrentFolder Dim expMessage As String = "Your current folder is " & selectedFolder.Name & "." & vbLf Dim itemMessage As String = "Item is unknown." oufolder = CType(Application.GetNamespace("MAPI").GetFolderFromID(selectedFolder.EntryID), Outlook.Folder) Try If Me.Application.ActiveExplorer().Selection.Count > 0 Then Dim selObject As Object = Me.Application.ActiveExplorer().Selection(1) If TypeOf selObject Is Outlook.MailItem Then Dim mailItem As Outlook.MailItem = (TryCast(selObject, Outlook.MailItem)) itemMessage = "The item is an e-mail message." & " The subject is " & mailItem.Subject & "." If mailItem Is SelectedMail Then Exit Sub Else MailOpened = False End If SelectedMail = mailItem 'mailItem.Display(False) ElseIf TypeOf selObject Is Outlook.ContactItem Then Dim contactItem As Outlook.ContactItem = (TryCast(selObject, Outlook.ContactItem)) itemMessage = "The item is a contact." & " The full name is " & contactItem.Subject & "." 'contactItem.Display(False) ElseIf TypeOf selObject Is Outlook.AppointmentItem Then Dim apptItem As Outlook.AppointmentItem = (TryCast(selObject, Outlook.AppointmentItem)) 'itemMessage = "The item is an appointment." & " The subject is " & apptItem.Subject & "." ElseIf TypeOf selObject Is Outlook.TaskItem Then Dim taskItem As Outlook.TaskItem = (TryCast(selObject, Outlook.TaskItem)) 'itemMessage = "The item is a task. The body is " & taskItem.Body & "." ElseIf TypeOf selObject Is Outlook.MeetingItem Then Dim meetingItem As Outlook.MeetingItem = (TryCast(selObject, Outlook.MeetingItem)) 'itemMessage = "The item is a meeting item. " & "The subject is " & meetingItem.Subject & "." End If End If expMessage = expMessage + itemMessage Catch ex As Exception expMessage = ex.Message End Try MapiPath = selectedFolder.Parent End Sub Public Shared Sub MailIsChanged(sender As System.Object) Handles SelectedMail.PropertyChange 'If MailOpened = False Then MailChanged(sender) 'End If End Sub Public Shared Sub MailChanged(sender As System.Object, Optional ByRef Mail As Outlook.MailItem = Nothing, Optional ByVal Commenttext As String = "") ' If MailOpened = True And SendFromOpenMail = True Then RemoveHandler SelectedMail.PropertyChange, AddressOf MailChanged 'MsgBox(MailOpened) Dim Changes As String = Date.Now.ToString & ": " If Mail Is Nothing Then Mail = SelectedMail If sender IsNot Nothing Then Select Case sender.ToString Case "Categories" If Mail.Categories IsNot Nothing Then Changes &= "Kategorie geändert auf " & Mail.Categories.ToString & " von: " Else Changes &= "Kategorie gelöscht von: " End If Case "UnRead" If Mail.UnRead = True Then Changes &= "Mail als ungelesen markiert von: " Else Changes &= "Mail als gelesen markiert von: " End If 'Case "FlagStatus" ' MsgBox("FlagStatus") Case Else Exit Sub End Select Else Changes &= Commenttext End If Changes &= " " & VERAG_PROG_ALLGEMEIN.cAllgemein.USRNAME Mail.FormDescription.Comment &= Changes & vbCrLf Mail.Save() ' MsgBox(Changes) End Sub Public Sub TestPrintFirstPage() Dim Mail As Outlook.MailItem Mail = Application.ActiveExplorer.Selection(1) PrintFirstPage2(Mail) End Sub Public Sub PrintFirstPage2(Mail As Outlook.MailItem) ' Dim wdApp As Word.Application ' Dim wdDoc As Word.Document ' Dim olDoc As Word.Document ' wdApp = CreateObject("Word.Application") ' wdDoc = wdApp.Documents.Add(Visible:=True) '' olDoc = Mail.GetInspector.WordEditor ' olDoc.Range.Copy() ' wdDoc.Range.Paste() ' wdDoc.PrintOut(Range:="wdPrintFromTo", From:="1", To:="1") 'DoEvents() ' wdDoc.Close(False) ' wdApp.Quit() End Sub Private Sub checkConnection() Dim con = New VERAG_PROG_ALLGEMEIN.SQL If con.getValueTxtBySql("SELECT 1", "FMZOLL") <> 1 Then MsgBox("ACHTUNG: Server nicht erreichbar!" & vbCrLf & "VERAG ADD In wird beendet") End If 'For Each COMAddIn As COMAddIn In Me.Application.COMAddIns ' If (COMAddIn.ProgId.Contains("< ADDIN_PROG_ID >")) Then ' COMAddIn.Connect = False ' Exit Next End Sub End Class