创建一个前景规则以根据主题行中的文本创建文件夹(如果需要) [英] create an outlook rule to create folders if needed based on text in subject line

问题描述

我正在寻找一种清晰的方法，以便在接收到邮件时使用vba来阅读电子邮件的主题行，以便创建新文件夹或仅使用现有文件夹将电子邮件移入其中.我看到了一些vba示例，但没有一个用Outlook解决vba编辑器中发现的新邮件方法.

I'm looking for a clear way to use vba to read subject line of email when received in order to either create a new folder or just use existing folder to move the email into. I have seen some vba examples but none address the new mail methods found in the vba editor with outlook.

推荐答案

我只是为此编写了代码.我的宏在电子邮件中搜索特定的字符串，然后接收所有内容，然后使用该名称创建一个文件夹.您将需要一些功能来: 1)检查文件夹是否已经存在 2)创建它，如果没有 3)将MailItem移到新文件夹 4)调用这些功能

I JUST wrote code for this. My macro searches emails for a specific string and then takes everything after that and creates a folder using that name. You'll need a few functions to: 1) Check to see if the folder already exists 2) Create it if it doesn't 3) Move the MailItem to the new folder 4) Call those functions

注意:其中很多都是硬编码的，可以根据需要更改为接受用户输入.另外，它不适用于子文件夹(您必须对其进行自定义).

NOTE: Much of this is hard-coded and could be changed to take user input if desired. Also, it will not work for sub-folders (you'll have to customize that).

1)检查文件夹:

Function CheckForFolder(strFolder As String) As Boolean

    Dim olApp As Outlook.Application
    Dim olNS As Outlook.NameSpace
    Dim olInbox As Outlook.MAPIFolder
    Dim FolderToCheck As Outlook.MAPIFolder


    Set olApp = Outlook.Application
    Set olNS = olApp.GetNamespace("MAPI")
    Set olInbox = olNS.GetDefaultFolder(olFolderInbox)

    On Error Resume Next
    Set FolderToCheck = olInbox.Folders(strFolder)
    On Error GoTo 0

    If Not FolderToCheck Is Nothing Then
        CheckForFolder = True
    End If

ExitProc:
    Set FolderToCheck = Nothing
    Set olInbox = Nothing
    Set olNS = Nothing
    Set olApp = Nothing
End Function

2)创建:

Function CreateSubFolder(strFolder As String) As Outlook.MAPIFolder

    Dim olApp As Outlook.Application
    Dim olNS As Outlook.NameSpace
    Dim olInbox As Outlook.MAPIFolder

    Set olApp = Outlook.Application
    Set olNS = olApp.GetNamespace("MAPI")
    Set olInbox = olNS.GetDefaultFolder(olFolderInbox)

    Set CreateSubFolder = olInbox.Folders.Add(strFolder)

    ExitProc:
    Set olInbox = Nothing
    Set olNS = Nothing
    Set olApp = Nothing
End Function

3)搜索并移动:

Function SearchAndMove(lookFor As String)

 Dim olApp As Outlook.Application
 Dim olNS As Outlook.NameSpace
 Dim olInbox As Outlook.MAPIFolder
 Dim FolderToCheck As Outlook.MAPIFolder
 Dim myItem As Object
 Dim MyFolder As Outlook.MAPIFolder
 Dim lookIn As String
 Dim newName As String
 Dim location As Integer


 Set olApp = Outlook.Application
 Set olNS = olApp.GetNamespace("MAPI")
 Set olInbox = olNS.GetDefaultFolder(olFolderInbox)
     For Each myItem In olInbox.Items
     lookIn = myItem.Subject
     If InStr(lookIn, lookFor) Then
         location = InStr(lookIn, lookFor)
                 newName = Mid(lookIn, location)
            If CheckForFolder(newName) = False Then
                Set MyFolder = CreateSubFolder(newName)
                myItem.Move MyFolder
                    Else
                Set MyFolder = olInbox.Folders(newName)
                myItem.Move MyFolder
            End If
        End If
    Next myItem
End Function

4)调用功能:

Sub myMacro()
    Dim str as String
    str = "Thing to look for in the subjectline"
    SearchAndMove (str)

End Sub

这篇关于创建一个前景规则以根据主题行中的文本创建文件夹(如果需要)的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！