VBA发Out-of-office in outlook

单位的Jira 和Outlook联系的不够紧密，总之OOO的状态无法让那些Jira上发任务Ticket的人知道，这么着还是挺容易误事的。遂做了一个VBA 工具，小规模解决下这个问题。

另外，TrustCentre里面的Macro Setting要改一改，至少改到，所有的轰都prompted，或者就直接允许。这个会有一些宏病毒风险。

Private WithEvents Items As Outlook.Items

'Create for Jira OutOfOffice Notice email in outlook
'Please review below comment lines and change the info according to you
'Alt+F11 switch to VB Editor, paste the code to "ThisOutlookSession"
'Go to Trust Center under Macro tab, Trust all Macro, or if it is signed, you can just trust VBA with Signature
'Restart outlook

Private Sub Application_Startup()
  Dim olApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Set olApp = Outlook.Application
  Set objNS = olApp.GetNamespace("MAPI")
  ' default local Inbox
  Set Items = objNS.GetDefaultFolder(olFolderInbox).Folders("Jira").Items  'Change to Jira Folder if you have any...
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)

  On Error GoTo ErrorHandler
  
  Dim oNS As Outlook.NameSpace
  Dim oStores As Outlook.Stores
  Dim oStr As Outlook.Store
  Dim oPrp As Outlook.PropertyAccessor
  Dim olReply As Object
  
  Dim myName As String
  myName = "MSS"    'Change to your email display name
  
  
  Set oNS = Outlook.GetNamespace("MAPI")
  Set oStores = oNS.Stores
  
  
  Dim Msg As Outlook.MailItem
  


  For Each oStr In oStores
     If oStr.ExchangeStoreType = olPrimaryExchangeMailbox Then
        Set oPrp = oStr.PropertyAccessor
            If (oPrp.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x661D000B") = True) Then   'Check OOO status
       
                If TypeName(item) = "MailItem" Then
                    Set Msg = item
              
                    If InStr(Trim(Msg.Sender), myName) <= 0 And InStr(Trim(Msg.Sender), "(JIRA)") > 0 Then  'Only Jira sent mail would be reply
              
                        For k = Msg.Recipients.Count To 1 Step -1

                            If Msg.Recipients.item(k) = myName Then   'In case you send it to yourself

                                Set olReply = Msg.ReplyAll
                                olReply.Recipients.Remove (1)
                                
                                strNum = InStr(Trim(Msg.Sender), "(") - 1
                                
                                SenderName = Trim(Mid(Trim(Msg.Sender), 1, strNum))

                        
                                Set olRecip = olReply.Recipients.Add(Replace(SenderName, " ", ".") & "@wswswsws.com")
                    
                                olReply.HTMLBody = "Hello, Thank you." & vbCrLf & _
                                        "As I'm currently out of office please contact my manager for urgent JIRA tasks." & vbCrLf & olReply.HTMLBody
                  
                                olReply.Send

                                Exit For
                  
                            End If
                
                        Next
                
                    End If
              
                End If
        
            End If
        
     End If
     
  Next
  
  

ProgramExit:
  Exit Sub
ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description
  Resume ProgramExit
End Sub