对所有打开的电子邮件执行操作并移至文件夹

时间:2013-06-19 18:41:54

标签: vba outlook-2007

我们公司正在使用Enterprise Vault系统存储已归档的电子邮件。有10%的时间我能够检索到我的电子邮件。所以我正在开关将它们存储在我的电脑上。

以下是我要做的事情:

  1. 在“已存档”文件夹中计算x个电子邮件数
  2. 在“已存档”文件夹
  3. 中打开n个电子邮件项目
  4. 复制n个电子邮件项目
  5. 将n个电子邮件项目移至“computer”文件夹(注意:电子邮件必须打开并移动。
  6. 关闭电子邮件窗口
  7. 重复直到n = x
  8. 我的电脑上有一个.pst文件夹。

    有人可以帮我开发最简单的代码来完成第2步吗?

    这就是我到目前为止......

    Sub MoveToFolder()
    
    Dim olApp As New Outlook.Application
    Dim olNameSpace As Outlook.NameSpace
    Dim olArcFolder As Outlook.MAPIFolder
    Dim olCompFolder As Outlook.MAPIFolder
    Dim mailboxNameString As String
    Dim myInspectors As Outlook.MailItem
    Dim myCopiedInspectors As Outlook.MailItem
    Dim x As Integer
    Dim iCount As Integer
    
    mailboxNameString = "Emails Stored on Computer"
    Set olNameSpace = olApp.GetNamespace("MAPI")
    Set olArcFolder = olNameSpace.Folders(mailboxNameString).Folders("Archived")
    Set olCompFolder = olNameSpace.Folders(mailboxNameString).Folders("Computer")
    
    'Make some kind of loop that counts the emails in the folder "Computer"
    'opens it up, and then moves it to the folder "Archived"
    Set myInspectors = Outlook.Application.ActiveInspector.CurrentItem
    Set myCopiedInspectors = myInspectors.copy
    myCopiedInspectors.Move (olCompFolder)
    'next email
    

1 个答案:

答案 0 :(得分:2)

好吧,伙计们,我猜我毕竟是在教自己。这适用于我想要的。

Sub MoveToFolder()

Dim olApp As New Outlook.Application
Dim olNameSpace As Outlook.NameSpace
Dim olArcFolder As Outlook.MAPIFolder
Dim olCompFolder As Outlook.MAPIFolder
Dim mailboxNameString As String
Dim myInspectors As Outlook.MailItem
Dim myCopiedInspectors As Outlook.MailItem
Dim myItem As Outlook.MailItem
Dim M As Integer
Dim iCount As Integer

Set olNameSpace = olApp.GetNamespace("MAPI")
Set olArcFolder = olNameSpace.Folders("Emails Stored on Computer").Folders("Archived")
Set olCompFolder = olNameSpace.Folders("Emails Stored on Computer").Folders("Computer")


For M = 1 To olArcFolder.items.Count
    Set myItem = olArcFolder.items(M)
    myItem.Display
    Set myInspectors = Outlook.Application.ActiveInspector.CurrentItem
    Set myCopiedInspectors = myInspectors.copy
    myCopiedInspectors.Move olCompFolder
    myInspectors.Close olDiscard
Next M



End Sub