none
Outlook 2003/2007 Nachverfolgungstermin aktivieren anhand Betreffzeile RRS feed

  • Frage

  • Hallo zusammen,

    ich würde gerne die Nachverfolgung in Outlook etwas automatisieren.

    Im Betreff der Mails steht immer text text text T: Datum. Nun soll das Programm die Betreffzeile auslesen und die Mail anhand des Datums zur Nachverfolgung markieren.

    Das ganze funktioniert auch schon soweit ABER die Mail wird nur für den Empfänger zur Nachverfolgung markiert.. Nicht für mich.

    Wie markiere ich die Mail für mich auch zur Nachverfolgung?

    Public Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    
    Dim sName As String
    Dim prompt As String
    Dim lPos As Long
    Dim sTermin As String
    Dim Mail As Outlook.MailItem
    Dim obj As Object
    Dim Sel As Outlook.Selection
    Dim i&
    Dim dt As Date
    Dim tm As String
    Dim Icon As OlFlagIcon
     
    sName = "T:"
     
    If InStr(Item.Subject, "T:") Then
        lPos = InStr(1, Item.Subject, sName, vbTextCompare)
        sTermin = Mid(Item.Subject, lPos + 3)
        dt = sTermin
        prompt = "Nachverfolgung " & sTermin
                If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbYes Then
                ' Cancel = True
                 'dt = DateAdd("d", 1, Date)
                 tm = CStr(dt)
                 Icon = olRedFlagIcon
                Set obj = Application.ActiveWindow
                    If TypeOf obj Is Outlook.Explorer Then
                    Set Sel = obj.Selection
                    For i = 1 To Sel.Count
                      Set obj = Sel(i)
                        If TypeOf obj Is Outlook.MailItem Then
                         Set Mail = obj
                          Mail.FlagDueBy = tm
                          Mail.FlagIcon = Icon
                          Mail.Save
                         End If
                     Next
                     Else
                      Set obj = obj.CurrentItem
                         If TypeOf obj Is Outlook.MailItem Then
                          Set Mail = obj
                          Mail.FlagDueBy = tm
                          Mail.FlagIcon = Icon
                          Mail.Save
                         End If
                     End If
                End If
    End If
    End Sub

    Vielen Dank schon mal

    Gruß Matze


    • Bearbeitet Matzekais Montag, 4. Juni 2012 07:09
    Montag, 4. Juni 2012 07:09

Antworten

Alle Antworten