Editing extended file properties using powershell or VBA?

Question

Is there a way to edit/change the extended file properties of a file using powershell? In particular I'd like to change the extended file properties of a .msg file which has been exported from outlook. I have seen a program online (proprietary code) that saves a .msg file with extended file properties such that it can be sorted in file explorer. The extended properties that were enabled on the .msg were useful information such as date received, the sender etc.

I can't for the life of me find an easy way of doing this in VBA or powershell and I'm wondering if anyone has any ideas or solutions. Currently I've created a macro that simply saves the information in the file name but putting it in the extended file properties is much more useful.

What frustrates me the most is that someone has clearly done this and I don't know how. I would have thought it would be quite simple. Alas.

EDIT: Please see my current code

Public Sub SaveMessageAsMsg()
Dim xMail As Outlook.MailItem
Dim xObjItem As Object
Dim xPath As String
Dim xDtDate As Date

Dim xName, xFileName As String
On Error Resume Next
Set xShell = CreateObject("Shell.Application")
Set xFolder = xShell.BrowseForFolder(0, "Select a folder:", 0, "C:\Users\" & Environ("UserName") & "ANON VARIABLE")
If Not TypeName(xFolder) = "Nothing" Then
    Set xFolderItem = xFolder.self
    xFileName = xFolderItem.Path & "\"
Else
    xFileName = ""
    Exit Sub
End If
For Each xObjItem In Outlook.ActiveExplorer.Selection
    If xObjItem.Class = olMail Then
        Set xMail = xObjItem
        SenderName = xMail.SenderName
        xName = xMail.Subject
        xDtDate = xMail.ReceivedTime
        xName = Replace(Format(xDtDate, "yyyy-mm-dd ", vbUseSystemDayOfWeek, _
          vbUseSystem) & " @ " & Format(xDtDate, "hh:mm:ss", _
          vbUseSystemDayOfWeek, vbUseSystem) & " - " & SenderName & " - " & xName & ".msg", ":", ".")
        Dim RegEx As Object
        Set RegEx = CreateObject("VBScript.RegExp")
        With RegEx
            .Pattern = "[\\/\*\?""<>\|]"
            .Global = True
            ValidName = .Replace(xName, "")
        End With       
        xPath = xFileName + ValidName
        xMail.SaveAs xPath, olMSG
    End If
Next
End Sub

Frustration? That is the nature of closed source software. This may be of interest. https://powershellmagazine.com/2015/04/13/pstip-use-shell-application-to-display-extended-file-attributes/ — lit, Mar 16 '22 at 20:41
Thanks lit, I had seen something similar with regards to viewing the file properties, it helped me get the actual indices of the properties I'm looking to edit. :) — Dead_Ling0, Mar 16 '22 at 21:25
See [Set & Get **CUSTOM** file properties with PowerShell](https://stackoverflow.com/questions/62564356/set-get-custom-file-properties-with-powershell) — Eugene Astafiev, Mar 16 '22 at 22:19

Dmitry Streblechenko · Accepted Answer · 2022-03-31T17:05:12.803

1

You cannot easily do that in VBA or Outlook Object Model: these extra properties must be set on the OLE storage level used by the MSG file.

If using Redemption (I am its author) is an option, it exposes olMsgWithSummary format (similar to olMsg and olMsgUnicode in OOM) that will do what you need. The script below saves the currently selected Outlook message:

set Session = CreateObject("Redemption.RDOSession")
Session.MAPIOBJECT = Application.Session.MAPIOBJECT
set oMsg = Application.ActiveExplorer.Selection(1)
set rMsg = Session.GetRDOObjectFromOutlookObject(oMsg)
rMsg.SaveAs "c:\temp\ExtraProps.msg", 1035 '1035 is olMsgWithSummary

Your script above would like like the following (off the top of my head):

Public Sub SaveMessageAsMsg()
Dim xMail As Outlook.MailItem
Dim xObjItem As Object
Dim xPath As String
Dim xDtDate As Date
Dim rSession As Object
Dim rSession As Object

Dim xName, xFileName As String
On Error Resume Next
Set xShell = CreateObject("Shell.Application")
Set xFolder = xShell.BrowseForFolder(0, "Select a folder:", 0, "C:\Users\" & Environ("UserName") & "ANON VARIABLE")
If Not TypeName(xFolder) = "Nothing" Then
    Set xFolderItem = xFolder.self
    xFileName = xFolderItem.Path & "\"
Else
    xFileName = ""
    Exit Sub
End If
set rSession = CreateObject("Redemption.RDOSession")
rSession.MAPIOBJECT = Outlook.Session.MAPIOBJECT
For Each xObjItem In Outlook.ActiveExplorer.Selection
    If xObjItem.Class = olMail Then
        Set xMail = xObjItem
        SenderName = xMail.SenderName
        xName = xMail.Subject
        xDtDate = xMail.ReceivedTime
        xName = Replace(Format(xDtDate, "yyyy-mm-dd ", vbUseSystemDayOfWeek, _
          vbUseSystem) & " @ " & Format(xDtDate, "hh:mm:ss", _
          vbUseSystemDayOfWeek, vbUseSystem) & " - " & SenderName & " - " & xName & ".msg", ":", ".")
        Dim RegEx As Object
        Set RegEx = CreateObject("VBScript.RegExp")
        With RegEx
            .Pattern = "[\\/\*\?""<>\|]"
            .Global = True
            ValidName = .Replace(xName, "")
        End With       
        xPath = xFileName + ValidName
        set rMsg = rSession.GetRDOObjectFromOutlookObject(xMail)
        rMsg.SaveAs xPath, 1035
    End If
Next
End Sub

edited Mar 31 '22 at 17:05

answered Mar 17 '22 at 02:45

Dmitry Streblechenko

62,942
4
53
78

Thanks for the information and also a possible solution. unfortunately I don't think Redemption will be an option for me. Hoping to get it all into one VBA macro within Outlook. Either through making PowerShell calls or just straight VBA. I do appreciate the above though and if circumstances change it might be an option. – Dead_Ling0 Mar 17 '22 at 08:44
I did try the above after installing the developer version and It threw up an error with the line Session.MAPIOBJECT. Method not found. Just making you aware :) – Dead_Ling0 Mar 17 '22 at 09:28
`Application` in the script above is assumed to point to an instance of the `Outlook.Application` object. What is your code? – Dmitry Streblechenko Mar 17 '22 at 17:55
Hi there, sorry for the slow reply, I've edited my question to contain my original code – Dead_Ling0 Mar 18 '22 at 16:26
See the updated answer above. – Dmitry Streblechenko Mar 18 '22 at 23:18
Thanks for the ongoing support, I did try the above it does run but it no longer saves anything :( – Dead_Ling0 Mar 21 '22 at 08:45
Remove `On Error Resume Next` and don't forget to install Redemption. – Dmitry Streblechenko Mar 21 '22 at 15:32
1

It worked, annoying that you have to use a third party to get it done very weird but thank you! – Dead_Ling0 Mar 21 '22 at 17:02
Curiously every time I close Outlook and run the macro it brings up a window with Outlook Redemption (Evaluation Version) License Agreement do you know why this is? – Dead_Ling0 Mar 22 '22 at 11:50
1

Eval version of Redemption displays that prompt every time it is loaded. If you need to get rid of the prompt, you need to purchase the distributed version. – Dmitry Streblechenko Mar 22 '22 at 13:28

Editing extended file properties using powershell or VBA?

1 Answers1