[英]Moving Emails in Outlook Folders to Subfolder with VBA according to Datasets in Excel
I found A question addresing this concern similar to mine here;我在这里发现了一个解决这个问题的问题,类似于我的问题;
How can I move Mails Items from Outlook Inbox with specific subject to specific folder/sub folder? 如何将具有特定主题的 Outlook 收件箱中的邮件项目移动到特定文件夹/子文件夹?
The first Module- The first part of this code- i have exported all email data to the spreadsheet successfully.第一个模块 - 此代码的第一部分 - 我已成功将所有电子邮件数据导出到电子表格。
The Second Module- I would like to instruct Excel VBA to Move Emails in the main Folder to a subfolder based on datasets i typed out in the spreadsheet ( it will not be based on a filter/Criteria of the emails itself,just its unique subject tittle).第二个模块 - 我想指示 Excel VBA 根据我在电子表格中输入的数据集将主文件夹中的电子邮件移动到子文件夹(它不会基于电子邮件本身的过滤器/标准,只是它的独特主题标题)。
In Column (c), is the subject of the email (All of the subject tittles are specific/unique) and in column (h), i have detailed the name of the sub-folder where i would like to have it moved too.在 (c) 列中,是电子邮件的主题(所有主题标题都是特定/唯一的),在 (h) 列中,我详细说明了我也希望将其移动的子文件夹的名称。 Unfortunately, i have an error while executing the code i created.
不幸的是,我在执行我创建的代码时出错。
I am a beginner in Excel VBA and dont have the best understanding.I got an idea of my code based on different sources, if its incorrect do let me know, it will be greatly appreciated我是 Excel VBA 的初学者,并没有最好的理解。我对基于不同来源的代码有所了解,如果不正确,请告诉我,将不胜感激
Thank you.谢谢你。
Sub MovingEmails_Invoices()
'Declare your Variables
Dim items As Outlook.items
Dim subfolder As Outlook.Folder 'this will be the folder you want to move the Mail to
'Set Outlook Inbox Reference
Set OP = New Outlook.Application
Set NS = OP.GetNamespace("MAPI")
Set Mail = OP.CreateItem(olMailItem)
'To loop through subfolder and its folders
Set rootfol = NS.Folders("SYNTHES-JNJCZ-GBS.DE.AT.CH@ITS.JNJ.com")
Set Folder = rootfol.Folders("Austria")
'The list for invoice number should be dynamic
Dim arraysearch(1 To 1000) As String
Dim i As Long
i = UBound(arraysearch)
arraysearch(i) = Range("C2").offset(i, 0).Value
If i = 0 Then
MsgBox "error"
Exit Sub
End If
'The list for folder type should be dynamic
Dim arraymove(1 To 1000) As String
i = UBound(arraymove)
arraymove(i) = Range("H2").offset(i, 0).Value
If i = 0 Then
MsgBox "error"
Exit Sub
End If
'specific folders for the mail to move to
Set subfolder = rootfol.Folders(arraymove(i))
For Each Mail In Folder.items.Restrict("[Subject] >= arraysearch(i)")
If arraysearch(i) = arraymove(i) Then
item.Move subfolder
End If
Next Mail
End Sub
In the code you are iterating over all items in the folder:在代码中,您要遍历文件夹中的所有项目:
'Loop through the Items in the folder backwards
'Setting Mail to counting backwards
For lngCount = items.Count To 1 Step -1
'setting object as Email item
Set item = items.item(lngCount)
This is really not a good idea.这真的不是一个好主意。 Especially if you later use the
Find
method.特别是如果您以后使用
Find
方法。
If you need to find items that correspond to your conditions I'd suggest using the Find
/ FindNext
or Restrict
methods of the Items class.如果您需要查找符合您条件的项目,我建议使用 Items 类的
Find
/ FindNext
或Restrict
方法。 Read more about these methods in the following articles:在以下文章中阅读有关这些方法的更多信息:
Also, you may find the AdvancedSearch method of the Application
class helpful.此外,您可能会发现
Application
类的AdvancedSearch方法很有帮助。 The key benefits of using the AdvancedSearch
method in Outlook are:在 Outlook 中使用
AdvancedSearch
方法的主要好处是:
AdvancedSearch
method runs it automatically in the background.AdvancedSearch
方法会在后台自动运行它。Restrict
and Find
/ FindNext
methods can be applied to a particular Items collection (see the Items
property of the Folder
class in Outlook). Restrict
和Find
/ FindNext
方法可以应用于特定的 Items 集合(请参阅 Outlook 中Folder
类的Items
属性)。IsInstantSearchEnabled
property of the Store
class).Store
类的IsInstantSearchEnabled
属性)。Stop
method of the Search
class.Search
类的Stop
方法停止搜索过程。There is no need to try to find the item.无需尝试查找该项目。
It is already identified with Set item = items.item(lngCount)
.它已经用
Set item = items.item(lngCount)
标识。
You can check the subject to see if it is the item you want.您可以检查主题,看看它是否是您想要的项目。
'Find Email using Subject found on Column C
'Set item = items.Find(FilterText)
'If the object is an Email
If item.Class = olMail Then
If item.Subject = FilterText Then
'Find item under the main Folder subfolders
Set subfolder = Folder.Folders(FolderMove)
'Mark Item as Read
item.UnRead = False
'Move Item to folder type in Outlook
item.Move subfolder
End If
End If
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.