Get the folder where the last mailitem was moved in Outlook?

Question

I have a vbscript macro that I'm using in Outlook. It moves a mailitem to some folder, say X. After I run the macro and I try to manually move a mailitem from Outlook with Control-v, it defaults to folder X. I would like Control-v to default to the folder that it would have used before I ran the macro.

Is there some way in VBScript to find out what folder the last mailitem was move to, and to return that to be the default folder after I run my script? Or is there a way to move a mailitem in my script without the destination folder being remembered by Outlook Control-v after I run the script?

Thanks for any hints.

OK, here is the code I'm using. It is a macro to save a mailitem as HTML and open it in a browser. I save any attachments in a separate directory and I add in a list of URLs to the attachments. I do this by modifying the mailitem, but I don't want change the original message - I want it to remain in my inbox as it was. So I create a copy and when I'm done I want to get rid of the copy. For some reason the .Delete method just doesn't do anything. So, one solution for me would be to figure out why .Delete is not working. I created a work-around by just moving the copied message into my deleted items folder. The problem I have with this is that I often use control-v to move items from my inbox to an archive folder. Once I run the macro, though, the default folder for control-v is the deleted item folder. I keep archiving items there by mistake. So the best solution would be to get .Delete working, but even then, that might change the control-v default behavior after running the macro.

Here's the code. I've only been doing vba for a couple of days, so any tips on things I'm missing appreciated.

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

i would not make a copy in the inbox and delete that afterwards (that will make your deleted-folder explode one day), but make your changes in the local copy of the message-file:

here an example:

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