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 outlookPrivate 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 SubPrivate 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 SubErrorHandler:  MsgBox Err.Number & " - " & Err.Description  Resume ProgramExitEnd Sub