Question

我有一个我在Outlook中使用的vbscript宏。它将mailitem移动到某个文件夹，例如X.在我运行宏并尝试使用Control-v从Outlook手动移动mailitem之后，它默认为文件夹X.我希望Control-v默认为它的文件夹在我运行宏之前会使用它。

在VBScript中是否有某种方法可以找出上一个mailitem移动到哪个文件夹，并在运行我的脚本后将其作为默认文件夹返回？或者有没有办法在我的脚本中移动mailitem而不运行脚本后Outlook Control-v记住目标文件夹？

感谢任何提示。

好的，这是我正在使用的代码。将mailitem保存为HTML并在浏览器中打开它是一个宏。我将所有附件保存在单独的目录中，并添加了附件的URL列表。我通过修改mailitem来做到这一点，但我不想更改原始邮件 - 我希望它保留在我的收件箱中。所以我创建了一个副本，当我完成后，我想摆脱副本。出于某种原因，.Delete方法不做任何事情。所以，对我来说，一个解决方案就是找出原因.Delete不起作用。我只是将复制的邮件移动到已删除的项目文件夹中，从而创建了一种解决方法。我遇到的问题是我经常使用control-v将项目从收件箱移动到存档文件夹。但是，一旦我运行宏，control-v的默认文件夹就是已删除的项目文件夹。我一直在那里存档物品。所以最好的解决方案是让.Delete工作，但即使这样，这可能会在运行宏之后改变control-v默认行为。

这是代码。我只做了几天的vba，所以关于我缺少的东西的任何提示都赞赏。

Option Explicit

Sub CreateHTML()

    Select Case TypeName(Outlook.Application.ActiveWindow)

    Case "Inspector"
        CreateHTMLfromObject Outlook.Application.ActiveInspector.CurrentItem

    Case "Explorer"
        Dim objItem As Object
        For Each objItem In Outlook.Application.ActiveExplorer.Selection
            CreateHTMLfromObject objItem
        Next

    End Select
End Sub

Sub CreateHTMLfromObject(objItem As Object)

    ' For now, assume all items are mail items
    'Select Case objItem.Class
    'Case olMail
    Dim objMailOrig     As MailItem
    Dim objMailCopy     As MailItem     ' Work on a copy of the message

    Set objMailOrig = objItem
    Set objMailCopy = objMailOrig.copy

    ' Where all HTML versions of messages will be stored
    Dim fileDir As String
    fileDir = "C:\Lib\olHTML\"

    ' A unique message id from the original message
    Dim MsgId As String
    MsgId = objMailOrig.EntryID

    ' The file the HTML version of the message will be stored in
    Dim fileName As String
    fileName = MsgId & ".html"

    ' The full file system path where the HTML verison of the message will be stored
    Dim filePath As String
    filePath = fileDir & fileName

    ' ---------------------------------------------------------------
    ' Save Attachments
    ' ---------------------------------------------------------------

    ' Subdirectory for attachments on this message
    ' A unique subdirectory for each message
    Dim atmtDir As String
    atmtDir = MsgId & "_atmt\"

    ' Full file system path to the attachment directory
    Dim atmtDirPath As String
    atmtDirPath = fileDir & atmtDir

    ' File system object for creating the attachment folder
    Dim oFSO
    Set oFSO = CreateObject("Scripting.FileSystemObject")

    If (objMailCopy.Attachments.Count > 0) And (Not oFSO.FolderExists(atmtDirPath)) Then
        oFSO.CreateFolder (atmtDirPath)
    End If

    ' To hold the full file system path to each attachment file
    Dim atmtFilePath As String

    ' String to accumulate HTML code for displaying links to attachments
    '   in the body of the HTML message
    Dim atmtLinks As String
    atmtLinks = " "

    Dim atmt As Attachment
    For Each atmt In objMailCopy.Attachments
        atmtFilePath = atmtDirPath & atmt.fileName
        atmt.SaveAsFile atmtFilePath
        ' create a relative URL
        atmtLinks = atmtLinks & _
            "<br><a href='" & atmtDir & atmt.fileName & "'>" & atmt.fileName & "</a>"
    Next atmt

    ' ---------------------------------------------------------------
    ' Add links to attachments
    ' ---------------------------------------------------------------
    ' This changes the original message in Outlook - so we work on a copy

    ' Convert body to HTML if RTF, Text or other format
    If (objMailCopy.BodyFormat = olFormatPlain Or olFormatRichText Or olFormatUnspecified) Then
        objMailCopy.BodyFormat = olFormatHTML
    End If

    ' Add attachments links at the beginning
    If objMailCopy.Attachments.Count > 0 Then
        objMailCopy.HTMLBody = _
            "<p>" & "Attachments: " & atmtLinks & "</p>" & objMailCopy.HTMLBody
    End If

    ' ---------------------------------------------------------------
    ' Save the HTML message file
    ' ---------------------------------------------------------------
    objMailCopy.SaveAs filePath, olHTML

    ' ---------------------------------------------------------------
    ' Delete the copy from Outlook
    ' ---------------------------------------------------------------

    '! This seems to have no effect
    ' objMailCopy.Delete

    ' Move copied message to deleted items folder

    objMailCopy.Move Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems)

    ' ---------------------------------------------------------------
    ' Open the HTML file with default browser
    ' ---------------------------------------------------------------
    Dim url As String
    url = "file:///" & filePath
    CreateObject("WScript.Shell").Run (url)

End Sub

Answer 1

我不会在收件箱中复制并删除之后（这将使您的已删除文件夹爆炸一天），但在邮件文件的本地副本中进行更改：

这里有一个例子：

Sub changelocalcopy(olitem As Outlook.MailItem)
 Dim oNamespace As Outlook.NameSpace
 Set oNamespace = Application.GetNamespace("MAPI")
 Dim oSharedItem As Outlook.MailItem
 Dim pfaddatei As String
 pfaddatei = c:\test.msg 'path for your local copy here
    olitem.SaveAsFile pfaddatei
    Set oSharedItem = oNamespace.OpenSharedItem(pfaddatei)
    'now do your changes 
    'you will not want the following line, I leave it here in case you Need it:
    Kill pfaddatei

    oSharedItem.Close (olDiscard)
  Set oSharedItem = Nothing
  Set oNamespace = Nothing
End Sub

获取在Outlook中移动最后一个mailitem的文件夹？

1 个答案: