件名のテキストに基づいて必要に応じてフォルダを作成するためのOutlookルールを作成する

Question

新しいフォルダを作成するか、既存のフォルダを使用するためにvbaを使用して電子メールの件名を読む明確な方法を探しています電子メールを移動する。私はいくつかのvbaの例を見てきましたが、Outlookでvbaエディタで見つかった新しいメールメソッドに対処していません。

Answer 1

this articleをチェックしてください。具体的には方法2と3を参照してください。正しい方向に向いていると思います。

Answer 2

私はこのためのコードを書いています。私のマクロは電子メールで特定の文字列を検索した後、そのすべてを取得し、その名前を使ってフォルダを作成します。

これらの機能を呼び出して）新しいフォルダ 4にMailItemを移動します）、それは 3ない場合は、それを作成します）フォルダがすでに 2を存在するかどうかを確認し 1）：あなたはにいくつかの関数が必要になります注：これの多くはハードコードされており、必要に応じてユーザー入力を行うように変更することができます。また、サブフォルダでは機能しません（カスタマイズする必要があります）。

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