0

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

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

感谢您的任何提示。

好的，这是我正在使用的代码。这是一个将邮件项保存为 HTML 并在浏览器中打开的宏。我将所有附件保存在一个单独的目录中，并将 URL 列表添加到附件中。我通过修改邮件项来做到这一点，但我不想更改原始邮件 - 我希望它保持原样保留在我的收件箱中。所以我创建了一个副本，当我完成后，我想摆脱这个副本。出于某种原因，.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
4

1 回答 1

0

我不会在收件箱中制作副本并在之后将其删除（这会使您的已删除文件夹有一天爆炸），而是在消息文件的本地副本中进行更改：

这里有一个例子：

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
于 2013-10-22T13:45:32.020 回答