zoukankan      html  css  js  c++  java
  • [转]VBA Check if an outlook folder exists; if not create it

    本文转自:http://www.outlookcode.com/d/code/quarexe.htm

    To quarantine application file attachments

    This Outlook VBA code sample monitors the Inbox folder for new items, looks for messages with attached files with the extensions listed in the USER OPTIONS section,

    and moves such messages to an InboxQuarantine folder for later review, creating the folder if it doesn't exist. 

    Place this code in the ThisOutlookSession module so that it runs when Outlook starts.

    Code Sample

    Private WithEvents olInboxItems As Items
    
    Private Sub Application_Startup()
      Dim objNS As NameSpace
      Set objNS = Application.GetNamespace("MAPI")
      Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
      Set objNS = Nothing
    End Sub
    
    Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
      Dim objAttFld As MAPIFolder
      Dim objInbox As MAPIFolder
      Dim objNS As NameSpace
      Dim strAttFldName As String
      Dim strProgExt As String
      Dim arrExt() As String
      Dim objAtt As Attachment
      Dim intPos As Integer
      Dim I As Integer
      Dim strExt As String
    
      ' #### USER OPTIONS ####
      ' name of Inbox subfolder containing messages with attachments
      strAttFldName = "Quarantine"
      ' delimited list of extensions to trap
      strProgExt = "exe, bat, com, vbs, vbe"
    
      On Error Resume Next
      Set objNS = Application.GetNamespace("MAPI")
      Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
      Set objAttFld = objInbox.Folders(strAttFldName)
      If Item.Class = olMail Then
        If objAttFld Is Nothing Then
          ' create folder if needed
          Set objAttFld = objInbox.Folders.Add(strAttFldName)
        End If
        If Not objAttFld Is Nothing Then
          ' convert delimited list of extensions to array
          arrExt = Split(strProgExt, ",")
          For Each objAtt In Item.Attachments
            intPos = InStrRev(objAtt.FileName, ".")
            If intPos > 0 Then
              ' check attachment extension against array
              strExt = LCase(Mid(objAtt.FileName, intPos + 1))
              For I = LBound(arrExt) To UBound(arrExt)
                If strExt = Trim(arrExt(I)) Then
                  Item.Move objAttFld
                  Exit For
                End If
              Next
            Else
              ' no extension; unknown type
              Item.Move objAttFld
            End If
          Next
        End If
      End If
    
      On Error GoTo 0
      Set objAttFld = Nothing
      Set objInbox = Nothing
      Set objNS = Nothing
      Set objAtt = Nothing
    End Sub

    Notes

    This code is no substitute for a good virus scanner

    In most versions of Outlook, application file types such as .exe are already blocked by the Outlook Email Security Update, so this code won't have any effect.

    You could adapt this technique to detect files of any particular type and perform specific processing on them. Don't forget that you must save an attachment first (Attachment.SaveAsFile) before you can access it with the methods appropriate for that file's application.

    More Information

  • 相关阅读:
    C# 操作Excel
    分享C#原生ID(流水号)生成功能实现
    Win7 64bit系统下未能加载文件或程序集“System.Data.SQLite”的解决办法
    c# 软件自动在线更新代码
    Win7 64bit系统下未能加载文件或程序集“System.Data.SQLite”的另一解决办法
    ActiveX控件的另类免费签名法(补充)
    ActiveX控件的另类免费签名法
    常用函数以及正则校验
    Delphi键盘按键伪码
    格林治时间
  • 原文地址:https://www.cnblogs.com/freeliver54/p/10816314.html
Copyright © 2011-2022 走看看