Results 1 to 2 of 2
  1. #1
    2 Star Lounger
    Join Date
    Jun 2001
    Location
    Oregon, USA
    Posts
    169
    Thanks
    45
    Thanked 2 Times in 2 Posts

    Add-in to file messages?

    Just moved to Office365. Any experiences with a utility to file the messages? MessageFiler is in the Office store, and there's another, QuickFile.

  2. #2
    Star Lounger Graham Mayor's Avatar
    Join Date
    Mar 2016
    Location
    Cyprus
    Posts
    68
    Thanks
    0
    Thanked 24 Times in 24 Posts
    I have no idea about the quoted utilities, but you can save individual messages to a Windows folder with an Outlook macro (and it's not much of a stretch to modify that to save a selection of messages, a folder full of messages or all messages) e.g.
    Code:
    Option Explicit
    
    Sub SaveMessage()
    'An Outlook macro by Graham Mayor - www.gmayor.com
    Dim olMsg As MailItem
        On Error Resume Next
        Set olMsg = ActiveExplorer.Selection.Item(1)
        SaveItem olMsg
    lbl_Exit:
        Set olMsg = Nothing
        Exit Sub
    End Sub
    
    Private Sub SaveItem(olItem As MailItem)
    'An Outlook macro by Graham Mayor - www.gmayor.com
    Dim fname As String
    Dim fPath As String
        fPath = InputBox("Enter the path to save the message." & vbCr & _
                         "The path will be created if it doesn't exist.", _
                         "Save Message", "C:\Outlook Message Backup\")
        CreateFolders fPath
    
        If olItem.Sender Like "*@gmayor.com" Then    'Your domain
            fname = Format(olItem.SentOn, "yyyymmdd") & Chr(32) & _
                    Format(olItem.SentOn, "HH.MM") & Chr(32) & olItem.SenderName & " - " & olItem.subject
        Else
            fname = Format(olItem.ReceivedTime, "yyyymmdd") & Chr(32) & _
                    Format(olItem.ReceivedTime, "HH.MM") & Chr(32) & olItem.SenderName & " - " & olItem.subject
        End If
        fname = Replace(fname, Chr(58) & Chr(41), "")
        fname = Replace(fname, Chr(58) & Chr(40), "")
        fname = Replace(fname, Chr(34), "-")
        fname = Replace(fname, Chr(42), "-")
        fname = Replace(fname, Chr(47), "-")
        fname = Replace(fname, Chr(58), "-")
        fname = Replace(fname, Chr(60), "-")
        fname = Replace(fname, Chr(62), "-")
        fname = Replace(fname, Chr(63), "-")
        fname = Replace(fname, Chr(124), "-")
        SaveUnique olItem, fPath, fname
    lbl_Exit:
        Exit Sub
    End Sub
    
    Private Function CreateFolders(strPath As String)
    'An Office macro by Graham Mayor - www.gmayor.com
    Dim strTempPath As String
    Dim lngPath As Long
    Dim vPath As Variant
    Dim oFSO As Object
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        vPath = Split(strPath, "\")
        strPath = vPath(0) & "\"
        For lngPath = 1 To UBound(vPath)
            strPath = strPath & vPath(lngPath) & "\"
            If Not oFSO.FolderExists(strPath) Then MkDir strPath
        Next lngPath
    lbl_Exit:
        Set oFSO = Nothing
        Exit Function
    End Function
    
    Private Function SaveUnique(oItem As Object, _
                                strPath As String, _
                                strFileName As String)
    'An Outlook macro by Graham Mayor - www.gmayor.com
    Dim lngF As Long
    Dim lngName As Long
    Dim oFSO As Object
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        lngF = 1
        lngName = Len(strFileName)
        Do While oFSO.FileExists(strPath & strFileName & ".msg") = True
            strFileName = Left(strFileName, lngName) & "(" & lngF & ")"
            lngF = lngF + 1
        Loop
        oItem.SaveAs strPath & strFileName & ".msg"
    lbl_Exit:
        Exit Function
    End Function
    Graham Mayor - Word MVP
    http://www.gmayor.com

  3. The Following User Says Thank You to Graham Mayor For This Useful Post:

    Auggie (2016-07-08)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •