cartmendum (cartmendum) wrote,
cartmendum
cartmendum

GTD Part II

Вторая часть рассказа про джедайскую технику пустого инбокса.

Тут точно со звуком


Option Explicit

' Эту макруху имеет смысл привязать к кнопке на самом видном месте панельки аутлука
' Работает в 2007 Аутлуке. На других не проверял
Sub EMailToActionItem()
    Dim app As New Outlook.Application
    Dim item As Object
    Set item = GetCurrentItem
   
    If item Is Nothing Then Exit Sub
   
    If item.Class <> olMail Then Exit Sub
   
    Dim email As MailItem
    Dim Who As String
   
    Set email = item
   
    Dim newTask As taskItem
    Set newTask = app.CreateItem(olTaskItem)
    ' Fill task properties
    If email.SenderName = "Maxim Dorofeev" Then '<- Замените здесь мое имя на ваше по мнению Outlook
        Who = email.To
    Else
        Who = email.SenderName
    End If
   
    newTask.Subject = Who + ": ... """ + email.Subject + """"
    newTask.StartDate = Int(email.ReceivedTime)
    newTask.DueDate = Date
    newTask.PercentComplete = 0
    newTask.Status = olTaskNotStarted
   
    ' Paste source e-mail as an attachment
    newTask.Attachments.Add item
   
    ' Write comment to the body
    newTask.Body = newTask.Body + "=====================================" + vbCrLf
    newTask.Body = newTask.Body + "   $Date-Created$ " + Str(email.ReceivedTime) + vbCrLf
    newTask.Body = newTask.Body + "=====================================" + vbCrLf
   
    Dim inspector As inspector
   
    Set inspector = newTask.GetInspector
       
    inspector.Display
   
End Sub

Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application
       
    Set objApp = CreateObject("Outlook.Application")
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
        Case "Explorer"
            Set GetCurrentItem = objApp.ActiveExplorer.Selection.item(1)
        Case "Inspector"
            Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
        Case Else
            ' anything else will result in an error, which is
            ' why we have the error handler above
    End Select
   
    Set objApp = Nothing
End Function





В этом блоге можно найти еще что-нибудь интересное
Tags: jedi tech, slidecast
Subscribe
  • Post a new comment

    Error

    Anonymous comments are disabled in this journal

    default userpic

    Your IP address will be recorded 

  • 17 comments