Microsoft Office. Outlook Add-in und Add-on Software.

 

 

 

 

 

 VBA; Programmierung mit Outlook - Projektverwaltung

Eine kleine Projektverwaltung

Download

Funktion:

  • Jedes Element in Outlook kann einem Projekt zugeordnet werden.
  • Der Zeitaufwand von Aufgaben kann zusammenaddiert werden.
  • Über QSeachFolders können alle Elemente eines Projektes in einem Ordner dargestellt werden.

Elemente, welche zu einem Projekt gehören, werden in der Übersicht ausgewählt, danach erfolgt ein Klick auf die Schaltfläche "Projekt" und die Auswahl eines Projektes. Wenn der Suchordner eingerichtet wurde, stehen die Elemente zusätzlich im Suchordner.

 

Wenn es sich um Aufgaben handelt, können alle zu einem Projekt gehörigen Zeiten zusammengezählt werden.

 

Installation:

  • Sie benötigen das Control Microsoft List View Component 5.0. Vor dem Import ein Formular öffnen, dort die Toolbox, dann Rechtsklick und Microsoft List View Control 5.0 hinzufügen.
  • Sie benötigen Microsoft Collobration Objects (CDO). Im CodeEditor F2, dann Referenzen, dann Microsoft Colloboration Data Objects auswählen.
  • Extrahieren Sie die folgenden Dateien und importieren jede einzelne in den VB-Editor
  • Wählen Sie in Outlook Extras/Anpassen und fügen die beiden Macros Project und ProjektTimes einer Toolbar hinzu.
  • Richten Sie einen Suchordner mit folgender Query ein: UserField(Projekt) = "Projektname"
  • Richten Sie Formulare mit Zusatzfeldern ein, z.B. IPM.Task.Projekt, falls dort weitere Daten pro Projekt gespeichert werden sollen, ansonsten nimmt Outlook immer das Standardformular
  • Optional kann ein Ordner "Projekte" angelegt werden (Typ beliebig) und ein Formular für Projekte erstellt werden, welches für jedes Projekt bestimmte Felder festhält. Die Projektverwaltung liest alle Elemente aus diesem Ordner aus und stellt diese in der Projektauswahl zur Verfügung.
  • Das Macro zum Zuordnen von Projekten heißt Projekt.SetProject
  • Das Macro zum Ermitteln der Zeiten heißt Projekt.CalcTask
  • In Outlook: Extras/Anpassen, eine Toolbar erzeugen und die Macros dort hineinschieben, eventuell mit Icons verschönern.

Die Komponente ListView hinzufügen (Rechtsklick in der Toolbox)

 

Die Bibliothek CDO 1.2 hinzufügen (F2 im Code-Editor)

Funktionsweise

  • Objekte, welche zu einem Projekt gehören erhalten ein benutzerdefiniertes Feld, welches den Namen des Projektes angibt
  • Die Nachrichtenklasse wird um ".Projekt" erweitert, dadurch können eigene Formulare angezeigt werden, zum Beispiel um den Projektnamen anzuzeigen.
  • Anhand dieses Feldes können Zeiten in Aufgaben zusammenaddiert werden.
  • Mit Hilfe von QSearchFolders können alle Elemente, welche zu einem Projekt gehören, zusammengetragen werden
  • Das Projekt kann in der Übersicht sowie im Formular angezeigt werden.

Bedienung

  • Um Elemente zu einem Projekt zuzuordnen, drücken Sie auf den Knopf "Projekt" und wählen das Projekt aus
  • Um den Aufwand für ein Projekt anzusehen, klicken Sie auf Zeiten Ausrechnen

 

Projektzuordnung und Ausrechnen der Zeiten

 

 

Ein Suchordner sucht alle Elemente eines Projekts.

 

Der Suchordner kann mit QSearchFolders eingerichtet werden oder manuell über die Extended MAPI-Funktion SetSearchCriteria erstellt werden. SetSearchKriteria ist nicht in CDO oder Outlook-API enthalten und kann daher nicht per Script bedient werden. 

 

Suchordner können auch per QSearchFolders hergestellt werden:

 

 

Einrichtung des Suchordners für Projekt 1

 

Funktion

 

Das Hauptprogramm arbeitet nach meinem Lieblingstyp: Irgendwas mit einer Auswahl machen. In diesem Fall die Nachrichtenklasse ändern und das Feld Projekt füllen. Vorher wird noch der Dialog zur Auswahl aufgerufen.

 

shared m_prj As String
shared projekte As New CProjekte

' Projekt auswählen und allen Elementen im Feld Projekt zuweisen
' Gleichzeitig wird die Message-Class geändert, es wird .Projekt angehägt, also aus ipm.task wird ipm.task.projekt
' Dies erlaubt das Erstellen eigener Formulare mit Projektvewaltung
' wenn es diese nicht gibt nimmt Outlook einfach das Standardformular

shared Sub SetProjekt()
  Dim form As New FormProjekt
  Dim obj As Object
  Dim userprop As UserProperty
 
  Dim m As MailItem
  form.Show 1
  For Each obj In Application.ActiveExplorer.Selection
       If obj.UserProperties.Find("Projekt") Is Nothing Then
       obj.UserProperties.Add "Projekt", olText, True
   End If
   obj.UserProperties.Find("Projekt").Value = m_prj
   If InStr(obj.MessageClass, ".Projekt") = 0 Then
      obj.MessageClass = obj.MessageClass & ".Projekt"
   End If
   obj.Save
   Next obj
   Unload form
End Sub

' Aufruf des Formulars welches die Zeiten zusammenaddiert

shared Sub CalcTask()
  Dim form As New FormProjektZeiten
  Set form.folder = Application.ActiveExplorer.CurrentFolder
  If form.folder.DefaultItemType = olTaskItem Then
     form.Init
     form.Show 1
  Else
     MsgBox "Bitte Aufgabenordner auswählen"
  End If
  Unload form
End Sub
 

Einstellungen speichern

 

Das Speichern der Einstellungen ist ein wenig Tricky, da wir die Einstellungen im Posteingang in einer verstecken Nachricht speichern wollen, dies kann Outlook nicht, deswegen wechseln wir zu CDO


 

shared m_projekte As New Collection ' Additional projects
shared m_folderProjekte As folder ' Projekt folder


' Wir fassen alles in m_projekte und alle Elemente im Ordner zusammen und liefern eine Liste zurück


shared Function GetProjects() As Collection
   Dim c As New Collection
   Dim s As String
   Dim i As Integer
   Dim obj As Object
   For i = 1 To m_projekte.Count
        s = m_projekte.Item(i)
        c.Add s
    Next i
    If Not (m_folderProjekte Is Nothing) Then
        For Each obj In m_folderProjekte.Items
            c.Add obj.Subject
        Next
    End If
    Set GetProjects = c
End Function
 

' Öffnen der Konfigurationsnachricht im Posteingang oder erstellen einer neuen
shared Function ConfigMsg() As MAPI.Message
   Dim msg As MAPI.Message
   Dim inbox As MAPI.folder
   Dim msgs As MAPI.Messages
   Dim session As New MAPI.session

   ' Direkte Übergabe der MAPI-Session an CDO:
   Set session.MAPIOBJECT = Application.GetNamespace("MAPI").MAPIOBJECT
   Set inbox = session.GetDefaultFolder(CdoDefaultFolderInbox)
   Set msgs = inbox.HiddenMessages
   For Each msg In msgs
        If msg.Subject = "Projects" Then
            Set ConfigMsg = msg
        Exit For
        End If
    Next msg


    If ConfigMsg Is Nothing Then
        Set msg = msgs.Add("Projects")
        msg.fields(CdoPR_MESSAGE_CLASS).Value = "IPM.Project"
        Set ConfigMsg = msg
     End If
End Function
 

' Abspeichern der Daten. Wir fassen die Projektnamen zusammen und speichern die ID des Projektordners
shared Sub Save()
   Dim fields As MAPI.fields
   Dim field As MAPI.field
   Dim config As MAPI.Message
   Dim s As String
   Dim i As Integer
   Dim line As String
   For i = 1 To m_projekte.Count
        line = m_projekte.Item(i)
        s = s + line + vbCr
    Next i
    Set config = ConfigMsg
    If Not m_folderProjekte Is Nothing Then
       Set fields = config.fields
       Set field = Nothing
       On Error Resume Next
       Set field = fields.Item("projectfolder")
       On Error GoTo 0
       If field Is Nothing Then Set field = fields.Add("projectfolder", CdoString)
       field.Value = m_folderProjekte.EntryID
     End If
     config.text = s
     config.Update
End Sub
 

' Beim Laden andersherum
shared Sub Load()
   Dim config As MAPI.Message
   Dim text As String
   Dim s As String
   Set config = ConfigMsg
   If Not (config Is Nothing) Then
   text = config.text
   Do
       p = InStr(1, text, vbCr)
       If p = 0 Then
          m_projekte.Add text
          Exit Do
      Else
         s = Left(text, p - 1)
         text = Mid(text, p + 1)
      End If
      m_projekte.Add s
      Loop
      On Error Resume Next
      Set field = Nothing
      Set fields = config.fields
      Set field = fields.Item("projectfolder")
      On Error GoTo 0
      If Not (field Is Nothing) Then
         On Error Resume Next
         id = field.Value
         Set m_folderProjekte = Application.GetNamespace("MAPI").GetFolderFromID(id)
         On Error GoTo 0
      End If
  End If
End Sub

shared Sub Init()
    If m_projekte.Count = 0 Then Load
End Sub


Private Sub Class_Initialize()
    Set m_folderProjekte = Nothing
    Load
End Sub