Outlook 2003 / VBA Movin电子邮件,而不更改日期 [英] Outlook 2003/VBA Movin E-Mails without changing the date

查看:111
本文介绍了Outlook 2003 / VBA Movin电子邮件,而不更改日期的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

我在outlook 2003中使用宏将选定的电子邮件移动到特定文件夹。移动的作品,但不幸的是收到的日期被覆盖到当前的时间。
关于如何防止这种情况的任何想法。

I use a macro in outlook 2003 to move selected emails to a specific folder. The moving works, but unfortunately the received date is overwritten to the current time. Any idea on how to prevent this.

我使用这段代码:

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的帮助我来了这样:

Thanks to the help of 76mel I came up with this:

    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?

This works when I am in my Inbox. Does anybody know how I can set the Store-ID in GetMessageFromID to the ID of the store in which my selection is made?

编辑:谢谢76mel,我使用objItem .Parent.StoreID现在得到当前的StoreID。

Thanks 76mel, I am using objItem.Parent.StoreID now to get the current StoreID.

推荐答案

你的权利已经有一些关于网络的报道说,它没有不工作

Your right there has been a few reports around the net saying it doesn’t work.

看起来VB6不会出现错误:(我认为解决这个问题的方法是使用CDO或defacto第三方lib兑换。在后台进行实际的移动。

It would seem that VB6 doesn’t bubble up an error :( . I think that the way to tackle this would be to use CDO or the defacto 3rd party lib "Redemption". To do the actual move in the background.

M

更新:
尝试这样的东西我没有VB可能机器,所以没有测试它
但你会得到的想法。

Update: Try something like this .. I dont have VB on may machine so haven't tested it But you will get the idea.

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

这篇关于Outlook 2003 / VBA Movin电子邮件,而不更改日期的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆