Rich;333351 said:
Does anyone know how to change the default format to .msg (Outloo
Message Format), when attempting to save messages in Outlook 2007
Either in the options or through Group Policy
Thank
I know this is an old post - but I thought I would share this wor
around I came up with today. ***Warning*** it does make use of VBA an
macros
The theory
By making use of the Windows API via the VBA editor in outlook - ope
the fileOpenSave dialog box - set the default file filter for the box
making *.msg as the default option. Once the save button is clicked
the VBA command objItem.SaveAs Filename, olMSG saves the file in th
location you browsed to in the dialog box.
By placing an icon on the quick access toolbar in outlook - an
selecting a macro as the command to run - you can then have a quick
easy way of saving emails as .msg files to your file system
The API call can be found at: 'API: Call the standard Windows Fil
Open/Save dialog box' (
http://www.mvps.org/access/api/api0001.htm) (man
thanks to these guys - awesome code samples
My Code: (this is the macro you need to point to
Sub SaveAsMSG(
Dim myItem As Outlook.Inspecto
Dim objItem As Objec
Dim strFilter As Strin
Dim strInputFileName As Strin
Dim InitDir As Strin
Dim Subject As Strin
Dim FileYea
Dim FileMont
Dim FileDa
Set myItem = Application.ActiveInspecto
If Not TypeName(myItem) = "Nothing" The
Set objItem = myItem.CurrentIte
Subject = objItem.Subjec
'InitDir change this to the default directory you would like t
point a
InitDir = "Y:\
'\ / : * ? " < > | (invalid characters to be removed fro
filename
'Subject parsin
If Subject <> "" The
For a = 1 To Len(Subject
test = InStr(a, Subject, "\"
If test > 0 Then Mid(Subject, test) = "-
test = InStr(a, Subject, "/"
If test > 0 Then Mid(Subject, test) = "-
test = InStr(a, Subject, ":"
If test > 0 Then Mid(Subject, test) = "
test = InStr(a, Subject, "*"
If test > 0 Then Mid(Subject, test) = "-
test = InStr(a, Subject, "?"
If test > 0 Then Mid(Subject, test) = "-
test = InStr(a, Subject, """"
If test > 0 Then Mid(Subject, test) = "'
test = InStr(a, Subject, "<"
If test > 0 Then Mid(Subject, test) = "-
test = InStr(a, Subject, ">"
If test > 0 Then Mid(Subject, test) = "-
test = InStr(a, Subject, "|"
If test > 0 Then Mid(Subject, test) = "-
Next
End I
'***************************************************
'Company specific filename prefix this section can be Rem'd ou
'if need be - it prefixes (yymmdd) 090428 as a date stamp t
the filenam
'strFileTitle - sets the default filename to be displayed i
the dialog bo
FileYear = Right(Year(Now), 2
FileMonth = Format(Month(Date), "00"
FileDay = Format(Day(Now), "00"
strFileTitle = FileYear & FileMonth & FileDay & " - " & Subjec
'****************************************************
strFilter = ahtAddFilterItem(strFilter, "MSG Files (*.msg)"
"*.msg"
strFilter = ahtAddFilterItem(strFilter, "HTML Files (*.HTML)"
"*.HTML"
strFilter = ahtAddFilterItem(strFilter, "Text Files (*.txt)"
"*.txt"
strFilter = ahtAddFilterItem(strFilter, "all Files (*.*)"
"*.*"
strInputFileName = ahtCommonFileOpenSave(
Filter:=strFilter,
InitialDir:=InitDir,
OpenFile:=False,
Filename:=strFileTitle,
FileTitle:=strFileTitle,
DialogTitle:="Save Email as...",
Flags:=ahtOFN_HIDEREADONLY
If Len(strInputFileName) > 0 The
FileExt = Right(strInputFileName, 4
Filename = strInputFileNam
Select Case FileEx
Case ".msg
objItem.SaveAs Filename, olMS
Case "HTML
objItem.SaveAs Filename, olHTM
Case ".txt
objItem.SaveAs Filename, olTX
End Selec
Exit Su
End I
Els
MsgBox "Please double click an email to open it - before savin
as an external file", vbInformation + vbOKOnly, "Outlook SaveAs dialog
End I
End Su
Hope this helps - Tremayne
