Public Sub MsgSave()

Dim oOutlook As Outlook.Application
Dim oMessage As Outlook.MailItem
Dim fname As String
Dim Datestamp As Date

'get reference to inbox
Set oOutlook = New Outlook.Application

'want to use this for saving from outlook main window...doesn't work
'Set oMessage = Application.ActiveExplorer.Selection

'use this to save a message that is opened
Set oMessage = oOutlook.ActiveInspector.CurrentItem

With oMessage

Datestamp = .SentOn

If UCase(Left(.subject, 14)) = Format(Datestamp, "yy_mm_dd hhnn ") Then
' if already starts with the date stamp then leave subject untouched
fname = .subject
Else
fname = Format(Datestamp, "yy_mm_dd hhnn ") & .subject
End If
.subject = fname
End With

Set oMessage = Nothing
Set oOutlook = Nothing

    Dim objOutlook As Outlook.Application
    Dim objCtl As Office.CommandBarControl
    Dim objPop As Office.CommandBarPopup
    Dim objCB As Office.CommandBar

    'Dim objblah As Office.FileTypes

    On Error Resume Next

    Set objOutlook = CreateObject("Outlook.Application")

    Set objCB = objOutlook.ActiveInspector.CommandBars("Menu Bar")
    Set objPop = objCB.Controls("File")
    Set objCtl = objPop.Controls("Save As...")
    'Set objblah = objCtl.Type(".msg")
    
    objCtl.Execute

    Set objCtl = Nothing
    Set objPop = Nothing
    Set objCB = Nothing
    Set objOutlook = Nothing

End Sub