问题描述
我正在寻找一种清晰的方法来使用 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
这篇关于如果需要,根据主题行中的文本创建 Outlook 规则以创建文件夹的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!
更多推荐
[db:关键词]
发布评论