2016-08-01 55 views
2

如何選擇共享帳戶(不是我的個人帳戶)的已刪除郵件文件夾中的所有郵件,然後將它們移動到不稱爲「已刪除郵件」。現在,我們稱目標文件夾爲「舊電子郵件」。選擇特定文件夾中的所有項目並將它們移動到另一個文件夾中

這是我到目前爲止寫:

'Macro for pseudo-archiving 
Sub PseudoArchive() 
On Error Resume Next 

Dim objNamespace As Outlook.NameSpace 
Dim sourceFolder As Outlook.MAPIFolder 
Dim Messages As Selection 
Dim Msg As MailItem 

Set objNamespace = GetNamespace("MAPI") 
Set sourceFolder = objNamespace.Folders("[email protected]") 
Set sourceFolder = objFolder.Folders("Deleted Items") 

'Define path to the target folder 
Set destinationFolder = ns.Folders("[email protected]").Folders("Old Emails") 

'Move emails in sourceFolder to destinationFolder 
For Each Msg In sourceFolder 
    Msg.Move destinationFolder 
Next 

Set objNamespace = Nothing 
Set sourceFolder = Nothing 
Set Messages = Nothing 
Set Msg = Nothing 

End Sub 

我停留在如何讓宏以選擇sourceFolder的所有項目,因此它可以然後將它們移動到destinationFolder。運行宏之前,我不想手動選擇文件夾中的電子郵件。

如果任何人都可以提供幫助,那將不勝感激。謝謝!

回答

2

SO不是一個代碼編寫服務,但這裏有一個代碼片段,應該有所幫助。

Dim olApp As Outlook.Application 
Dim olFol As Outlook.Folder, olDestFol As Outlook.Folder 
Dim olItem As Object 
Dim i as Long, j as Long 
Set olApp = New Outlook.Application olApp.GetNamespace("MAPI").Folders("mailboxnamehere").Folders("Deleted Items") 
Set olDestFol = olApp.GetNamespace("MAPI").Folders("mailboxnamehere").Folders("Inbox").Folders("Deleted Items") ' Destination Folder 
Do Until olFol.Items.Count = 0 
    olFol.Items(1).Move olDestFolder 
Loop 

如果您對此有任何疑問,請在評論中告訴我。

+0

你不應該修改該集合的「爲每個」循環。使用從倒數到1的下行循環。 –

+0

爲什麼您通過olFol分配引用olDestFol分配中的共享郵箱收件箱文件夾? – jshapy8

+0

因爲這是從我在另一個關於共享郵箱的答案中準備的代碼片段中複製的,但在這種情況下它將是您的電子郵件地址。 –

2

你幾乎得到了它,請嘗試以下

Option Explicit 
Sub PseudoArchive() 
    Dim objNamespace As Outlook.NameSpace 
    Dim sourceFolder As Outlook.MAPIFolder 
    Dim destinationFolder As Outlook.MAPIFolder 
    Dim Items As Outlook.Items 
    Dim Item As Object 
    Dim Msg As String 
    Dim i As Long 

    Set objNamespace = GetNamespace("MAPI") 
    Set sourceFolder = objNamespace.Folders("[email protected]").Folders("Deleted Items") 
    Set destinationFolder = objNamespace.Folders("shared[email protected]").Folders("Inbox").Folders("Old Emails") 
    Set Items = sourceFolder.Items 

    'Move emails in sourceFolder to destinationFolder 
    Msg = Items.Count & " Items in " & sourceFolder.Name & ", Move?" 

    If MsgBox(Msg, vbYesNo) = vbYes Then 
     For i = Items.Count To 1 Step -1 
      Set Item = Items.Item(i) 
      DoEvents 
      Item.Move destinationFolder 
     Next 
    End If 

End Sub 
相關問題