Get metadata from .msg files saved to local drive

[mail11]

Operating system::    Windows 10
Outlook version:     365
Email type or host:    365

---

Hi
Firstly, is it possible to get metadata information from saved .msg files to local drive, in particular "Title".
And then would it possible to edit this using Visual Basic.

The intention was to include From and To in the Title field so you could see this in Windows Explorer, as shown below.

I think it may be possible to include From and To in the Name of the saved email, however because of restrictions on number of characters in Windows Explorer (256 I think), this won't be practical.

Please assist or send links to other topics which may be relevant.

 

[Diane Poremsky]

Those are windows properties - they can be changed but need to use windows shell processes. I don't have any code that can update it.

 

[Hornblower409]

This is a skeleton scaffolding I pulled from an old project to get you started. Needs lots of work for your specific case. Good luck.

Public Sub TEST_UpdateMsgFileNames()

    '   Setup to walk thru all the files in a Windows Folder
    '
    Dim FolderPath As String
    FolderPath = "C:\JUNK\UpdateMsgFileNames"
    
    Dim UpdatedFolderPath As String
    UpdatedFolderPath = "C:\JUNK\UpdatedMsgFileNames"
    
    Dim glbFSO As Scripting.FileSystemObject
    Set glbFSO = New Scripting.FileSystemObject
    
    Dim oFolder As Scripting.Folder
    Set oFolder = glbFSO.GetFolder(FolderPath)
    
    Dim oFiles As Scripting.Files
    Set oFiles = oFolder.Files

    '   For each file ...
    '
    Dim oFile As Scripting.File
    For Each oFile In oFiles
    
        '   Open the MSG file as an Outlook Object
        '
        Dim FilePath As String
        FilePath = oFile.Path
        
        Dim oItem As Outlook.MailItem
        Set oItem = Session.OpenSharedItem(FilePath)
        
        ' ---------------------------------------------------------------------
        '   Extract info from the oItem MailItem and build a NewFileName
        '
        '       Needs a lot of detail code here. To extract the info wanted in the
        '       NewFileName from the MailItem, check for invalid characters in NewFileName,
        '       maximum File Name lenght, ad nauseam.
        '
        ' ---------------------------------------------------------------------
        
        '   e.g. Build a ToList string from Recipients
        '
        Dim oRecipients As Outlook.Recipients
        Set oRecipients = oItem.Recipients
        
        Dim RecipientsArray() As String
        ReDim RecipientsArray(1 To oRecipients.Count)
        Dim RecipientsIndex As Long
        For RecipientsIndex = 1 To oRecipients.Count
            RecipientsArray(RecipientsIndex) = oRecipients.Item(RecipientsIndex).Name
        Next RecipientsIndex
        
        Dim ToList As String
        ToList = Join(RecipientsArray, " ; ")
        
        '   Build the new file name
        '
        Dim NewFileName As String
        NewFileName = "To = " & ToList
        
        '  Copy the file as NewFileName to a different directory
        '
        '       SPOS - Stupid caches files opened with OpenSharedItem and there
        '       is no sure fire way to make him let go. So we can't just Rename (Move)
        '       the original in place.
        '
        '       https://stackoverflow.com/questions/14439689/openshareditem-for-opening-msg-files-showing-error-in-outlook-c-sharp
        '
        oFile.Copy UpdatedFolderPath & "\" & NewFileName & ".msg"
        
    Next oFile

End Sub

 

[Hornblower409]

You will need to add the "Microsoft Scripting Runtime" to your VBA References to run this code.

 

[Hornblower409]

Here is a function set from my framework for cleaning up a file name string. You can incorporate into UpdateMsgFileNames if appropriate.

' =====================================================================
'   FileSpec Cleanup
' =====================================================================

'   Replace any Invalid Characters in a full FileSpec
'
Public Function File_CleanupFileSpec(ByVal Raw As String, Optional ByVal RepChar As String = "_") As String

    '   Cut and save the "C:" or "\\" prefix
    '
    Dim Prefix As String
    Prefix = Left(Raw, 2)
    Raw = Mid(Raw, 3)
    
    '   Cleanup the remaining FileSpec
    '
    Dim PathPieces As Variant
    PathPieces = Split(Raw, "\")
    Dim PieceIx As Long
    For PieceIx = 0 To UBound(PathPieces)
        PathPieces(PieceIx) = File_CleanupNameSegment(PathPieces(PieceIx), RepChar)
    Next PieceIx
    
    '   Put the pieces back together with the Prefix
    '
    File_CleanupFileSpec = Prefix & Join(PathPieces, "\")

End Function

'   Replace any Invalid Characters in a Piece of a FileSpec
'
'       NOT for a full File Spec. Only pieces after "C:" and between "/\"s.
'       See: https://learn.microsoft.com/en-us/windows/win32/fileio/naming-a-file
'       2024-10-29 - Added any Control Chars
'
Public Function File_CleanupNameSegment(ByVal Raw As String, Optional ByVal RepChar As String = "_") As String

    Dim Cooked As String
    Cooked = Raw
    
    '   Replace any Control Chars
    '
    Dim AscV As Long
    Dim LoopIx As Long
    For LoopIx = 1 To Len(Cooked)
        AscV = Asc(Mid(Cooked, LoopIx, 1))
        Select Case AscV
            Case 0 To 31, 127, 251 To 255
                Cooked = Replace(Cooked, Chr(AscV), RepChar)
            Case Else
            ' Continue
        End Select
    
    Next LoopIx
    
    '   Replace any Invalids
    '
    Dim Invalids As String
    Invalids = "<>:""/\|?*"

    For LoopIx = 1 To Len(Invalids)
        Cooked = Replace(Cooked, Mid(Invalids, LoopIx, 1), RepChar)
    Next LoopIx

    File_CleanupNameSegment = Cooked

End Function

 

[mail11]

Thanks Hornblower409, have been though the code and it's very useful.
My best attempt to extract Title metadata is shown below but it doesn't work ... get the error message:
Run-time error '-2147467259 (800004005)': Method 'NameSpace' of object 'IShellDispatch6' failed.

The function to get Title is based on Excel algorithm, maybe that's why it doesn't work, but could it be modified to suit .msg files in a folder.

Also, the question of metadata for .msg files. Is Title available at all? And can it be modified?

Diane, you say it can be changed? Please elaborate.

Option Explicit

Public Sub TEST_UpdateMsgFileNames()
    Dim FolderPath As String
    Dim glbFSO As Scripting.FileSystemObject
    Dim oFolder As Scripting.Folder
    Dim oFiles As Scripting.Files
    Dim oFile As Scripting.File
    Dim FilePath As String
    Dim file_name As String
    Dim my_title As String
   
    FolderPath = "C:\_test"

    Set glbFSO = New Scripting.FileSystemObject
    Set oFolder = glbFSO.GetFolder(FolderPath)
    Set oFiles = oFolder.Files

    For Each oFile In oFiles
        FilePath = oFile.Path
        file_name = Mid(FilePath, InStrRev(FilePath, "\") + 1)
        my_title = get_title(FilePath, file_name):
        MsgBox my_title
    Next oFile
End Sub

Function get_title(ByVal FilePath As String, ByVal file_name As String)
    Dim objFolder As Object, objFolderItem As Object
    Dim objShell As Object
    Dim file_name_Unicode As String, file_path_Unicode As String
    file_name_Unicode = StrConv(file_name, vbUnicode)
    file_path_Unicode = StrConv(FilePath, vbUnicode)
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.NameSpace(StrConv(file_path_Unicode, vbFromUnicode))
    If Not objFolder Is Nothing Then
        Set objFolderItem = objFolder.ParseName(StrConv(file_name_Unicode, vbFromUnicode))
    End If
    If Not objFolderItem Is Nothing Then
        get_title = objFolder.GetDetailsOf(objFolderItem, 21) '21 is for Title
    End If
    Set objShell = Nothing
    Set objFolder = Nothing
    Set objFolderItem = Nothing
End Function

 

[Hornblower409]

Mail11

I am sorry. I completely misunderstood your original question. I thought you wanted to extract information from the contents of the MSG files (i.e. the email stored in the file). Not from the Windows file name and attributes.

 

[Diane Poremsky]

You need to get the msg properties - in a global variable - as you are saving the file then write it to the properties. I was testing one I found online and it didn't save the properties to the message - or they weren't showing up in file explorer. I was on the road and wasn't sure if it was because I was using parallels on my macbook (it's an ARM version of windows and can be weird) or the code. When I have a chance, I'll test it on my desktop.

But - as long as the code writes to the file system properties, code that works for Excel should work with a bit of tweaking. You need to get the field values before saving the message as a file.


Or maybe not... msg files don't have the same properties - I tried adding custom ones but the available list is not Title etc and the ones on the list aren't in the list of Explorer fields. You can type field names in - but they don't show in Explorer fields of the same name.

This is from a word doc - excel's is similar.

 

[mail11]

OK thanks Hornblower409 and Diane.

Or maybe not... msg files don't have the same properties

Diane, yes that's something that needs to be worked through.
The Title field doesn't show up when you right-click Properties/Details, neither do many other properties that would show up for Excel, Word or PDF files.
Thought that .msg have bee similar in some ways to .docx file.

Have you come across any information online that could assist?

 

[Hornblower409]

According to this article, you are not going to find much in the Windows File Metadata for MSG files:
https://www.filecats.co.uk/www.file...utlook-msg-files/viewing-in-windows-explorer/

Is changing to my original idea of extracting the data from the contents of the MSG files an option? What problem are you trying to solve?

 

[mail11]

Thanks Hornblower409 that was useful, it doesn't look promising.

Is changing to my original idea of extracting the data from the contents of the MSG files an option? What problem are you trying to solve?

I'm not quite sure what you mean by the first sentence, but in terms of extracting information (From, To), I was able to do that.
What I'm trying to do is to show the data from "From" and "To" somewhere other than the filename that can be seen in Windows Explorer (when in Details view). This is because there is a character limit with filenames in Windows Explorer (256 No. or similar), and even if there wasn't a limit, reading the email subject line I think is difficult for me. I save .msg files to local drive for information.
Using something like the Title field would have been perfect to store this data.

Please note I can't use or download software on computer, and prefer to do with Visual Basic.

 

[Hornblower409]

I found a possible from Attach metadata to outlook msg file that is visible in Windows Explorer Details view?

It's the (very old) "DSO Ole Document Properties Reader 2.1" COM DLL. It's a single file that you put anywhere on your system and then add it to your VBA References:

Then you can use it to update selected attributes of a Windows file. "Author" and "Subject" work. I haven't tried all the others:

Sub TEST_UpdateMsgAttributes()

    UpdateMsgAttributes ("C:\Junk\UpdateMsgFileNames\Parking spot.msg")

End Sub

Sub UpdateMsgAttributes(msgFile As String)

    Dim objDSO As Object
    Dim objVariant As Variant
    Dim oNamespace As NameSpace
    Dim strAuthor As String
    Dim strSubject As String
    Dim item As Outlook.MailItem

    ' Open the msg in Outlook to get the attributes from the MailItem
    '     Use CreateItemFromTemplate instead of OpenSharedItem
    '     because OpenSharedItem puts a lock on the file, and the lock is only
    '     released at an indeterminate time after releasing the mailitem
    ' Set oNamespace = Application.GetNamespace("MAPI")
    ' Set objVariant = oNamespace.OpenSharedItem(msgFile)
    Set objVariant = Application.CreateItemFromTemplate(msgFile)

    If objVariant.Class = olMail Then
        Set item = objVariant
        strAuthor = item.SenderName
        strSubject = item.Subject
    End If
    objVariant.Close olDiscard
    Set objVariant = Nothing

    ' Reopen the msg with DSOFile to edit its attributes
    Set objDSO = CreateObject("DSOFile.OleDocumentProperties")
    objDSO.Open msgFile
    objDSO.SummaryProperties.Author = strAuthor
    objDSO.SummaryProperties.Subject = strSubject
    objDSO.Save

End Sub

 

[mail11]

Thanks Hornblower409, this looks like a big step forward.

I followed the steps in post #12, but am getting the error message below.
I can see that it's worked on your system.

Tried "On Error Resume Next" before this part of the code but no luck.

 

[Hornblower409]

Do you have the "DSO Ole Document Properties Reader 2.1" file (dsofile.dll) on your system?
Did you add it to your VBA References?

 

[Hornblower409]

Switch to Early Binding:

Replace the line:

Set objDSO = CreateObject("DSOFile.OleDocumentProperties")

With the two lines:

    Dim objDSO As DSOFile.OleDocumentProperties
    Set objDSO = New DSOFile.OleDocumentProperties

 

[mail11]

Thanks again, Hornblower409.
Yes I did all those things.

With the error message it was different this time.

 

[Diane Poremsky]

That object is only in older versions of office as far as I know. No idea if it will work with current versions.

Way back machine has it -

Download Microsoft Developer Support OLE File Property Reader 2.1 Sample (KB 224351) from Official Microsoft Download Center

web.archive.org

 

[Diane Poremsky]

This is the macro I was trying in a windows vm over the weekend... that did not do anything to the fields in the view.

  Dim sPath As String
  Dim sSubject As String
  Dim sSender As String

Public Sub SaveMessageAsMsg()
  Dim oMail As Outlook.MailItem
  Dim objItem As Object
  Dim sPath As String
  Dim dtDate As Date
  Dim enviro As String
  Dim sName As String
 
    enviro = CStr(Environ("USERPROFILE"))
   For Each objItem In ActiveExplorer.Selection
   If objItem.MessageClass = "IPM.Note" Then
    Set oMail = objItem
  
  sSender = oMail.SenderName
  sSubject = oMail.Subject
  ReplaceCharsForFileName sSubject, "-"
 
  dtDate = oMail.ReceivedTime
  sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
    vbUseSystem) & Format(dtDate, "-hhnnss", _
    vbUseSystemDayOfWeek, vbUseSystem) & "-" & sSubject & ".msg"
    
    sPath = enviro & "\Documents\" & sName
  Debug.Print sPath
  oMail.SaveAs sPath, olMsg
 
  End If
  Next
 
End Sub
 
Private Sub ReplaceCharsForFileName(sName As String, _
  sChr As String _
)
  sName = Replace(sName, "'", sChr)
  sName = Replace(sName, "*", sChr)
  sName = Replace(sName, "/", sChr)
  sName = Replace(sName, "\", sChr)
  sName = Replace(sName, ":", sChr)
  sName = Replace(sName, "?", sChr)
  sName = Replace(sName, Chr(34), sChr)
  sName = Replace(sName, "<", sChr)
  sName = Replace(sName, ">", sChr)
  sName = Replace(sName, "|", sChr)
End Sub

Sub UpdateFileProperties()
    Dim objShell As Object
    Dim objFolder As Object
    Dim objFolderItem As Object
    Dim filePath As String
    
    ' Specify the file path
    filePath = sPath
    Debug.Print filePath
    ' Create a Shell object
    Set objShell = CreateObject("Shell.Application")
    
    ' Get the folder containing the file
    Set objFolder = objShell.NameSpace(GetFolderPath(filePath))
    
    ' Get the file item
    Set objFolderItem = objFolder.ParseName(GetFileName(filePath))
    
    ' Update the file properties
    objFolderItem.ExtendedProperty("Title") = sSubject
    objFolderItem.ExtendedProperty("Client") = sSender
    objFolderItem.Save
    
    ' Clean up
    Set objFolderItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing
    
    MsgBox "File properties updated successfully!"
End Sub

Function GetFolderPath(filePath As String) As String
    Dim pos As Integer
    pos = InStrRev(filePath, "\")
    GetFolderPath = Left(filePath, pos - 1)
End Function

Function GetFileName(filePath As String) As String
    Dim pos As Integer
    pos = InStrRev(filePath, "\")
    GetFileName = Mid(filePath, pos + 1)
End Function
--

 

[Hornblower409]

Thanks again, Hornblower409.
Yes I did all those things.

With the error message it was different this time.

View attachment 4484

Did you put in BOTH lines?

Dim objDSO As DSOFile.OleDocumentProperties
Set objDSO = New DSOFile.OleDocumentProperties

 

[mail11]

Yes I did put in both lines