2009-06-23 95 views
1

我在outlook 2003中使用宏將選定的電子郵件移動到特定的文件夾。移動的作品,但不幸的是收到的日期被覆蓋到當前時間。 關於如何防止這種情況的任何想法。Outlook 2003/VBA Movin電子郵件不更改日期

我用這個代碼:

Sub verschiebenInOrdner() 

On Error Resume Next 

    Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder 
    Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem 

    Set objNS = Application.GetNamespace("MAPI") 
    Set objInbox = objNS.GetDefaultFolder(olFolderInbox) 

    Set objFolder = objNS.Folders.Item("2009").Folders.Item("In") 

    If objFolder Is Nothing Then 
     MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER" 
    End If 

    If Application.ActiveExplorer.Selection.Count = 0 Then 
     Exit Sub 
    End If 

    For Each objItem In Application.ActiveExplorer.Selection 
     If objFolder.DefaultItemType = olMailItem Then 
      If objItem.Class = olMail Then 
       objItem.UnRead = False 
       objItem.Move objFolder 
      End If 
     End If 
    Next 

    Set objItem = Nothing 
    Set objFolder = Nothing 
    Set objInbox = Nothing 
    Set objNS = Nothing 
End Sub 

由於76mel的幫助下,我來到了這一點:

Sub verschiebenInArchiv() 

Dim Session As Redemption.rDOSession 
Dim objFolder As Redemption.RDOFolder 
Dim objItem As Outlook.MailItem 
Dim objItem2 As Redemption.RDOMail 

Set Session = CreateObject("Redemption.RDOSession") 

Session.Logon 

Set objFolder = Session.Stores.Item("2009").IPMRootFolder.Folders("In") 

If Application.ActiveExplorer.Selection.Count = 0 Then 
    Exit Sub 
End If 

For Each objItem In Application.ActiveExplorer.Selection 
    Set objItem2 = Session.GetMessageFromID(objItem.EntryID, Session.Stores.DefaultStore.EntryID) 
    objItem2.Move objFolder 
Next 

End Sub 

這時候我在我的收件箱的工作原理。有誰知道我可以如何將GetMessageFromID中的Store-ID設置爲我選擇的商店的ID?

編輯:謝謝76mel,我現在使用objItem.Parent.StoreID來獲取當前的StoreID。

+0

我不會改變我約會使用Outlook 2003(11.8118.8132)SP2 – 2009-06-23 19:29:21

+0

正如其他人所指出的,這不應該更改日期。也許你的實際代碼與你在這裏引用的有些不同? – 2009-06-24 06:24:45

+0

你是否正在運行任何其他代碼會改變日期? – 76mel 2009-06-24 08:07:11

回答

1

你在那裏有一些關於網絡的報告說它不起作用。

似乎VB6不會冒出一個錯誤:(我認爲解決這個問題的方法是使用CDO或事實上的第三方庫「Redemption」。在後臺執行實際的移動。

中號

更新: 嘗試是這樣的..我不有沒有可能機器所以沒有測試它 但你會得到的想法在VB

Sub verschiebenInOrdner() 

On Error Resume Next 


    Dim objNS As Outlook.NameSpace 
    Dim objRDOSession As Redemption.RDOSession 
    Dim objRDOFolder As Redemption.RDOFolder 
    Dim objItem As Outlook.MailItem 
    Dim objRDOMail As Redemption.RDOMail 


    Set objNS = Application.GetNamespace("MAPI") 
    Set objRDOSession = CreateObject("Redemption.RDOSession") 
    objRDOSession.MAPIOBJECT = objNS.MAPIOBJECT 'or Logon 

    Set objRDOFolder = Session.GetFolderFromPath("<YOUR PATH>") 
    ' do your validation for folder and selection 



    For Each objItem In Application.ActiveExplorer.Selection 
     If objFolder.DefaultItemType = olMailItem Then 
      If objItem.Class = olMail Then 
       Set objRDOMail = objRDOSession.GetMessageFromID(objItem.EntryID) 
       objRDOMail.UnRead = False 
       objRDOMail.Move objRDOFolder 

      End If 
     End If 
    Next 



    Set objItem = Nothing 
    Set objRDOMail = Nothing 
    Set objRDOFolder = Nothing 
    Set objRDOSession = Nothing 
    Set objNS = Nothing 
End Sub 
0

它也不會在Outlook 2003中更改我的日期。如果這是一個持續的問題,我會嘗試獲取該項目的日期並在轉移後覆蓋它。

0

我找到了解決方案:在您移動的子文件夾中電子郵件,只需添加一個字段「日期創建」而不是「收到日期」,並使用該字段進行排序......完成工作!

相關問題