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

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