A
Alexander Bub
G'day,
I work on a VB app that opens .msg files and saves them as either plain
text, HTML or RTF files, depending on the message format. To bypass the
security prompt in Outlook 2003, I use Outlook Redemption 4.1.0.507. I need
to support both Outlook 2000 and 2003.
The problem is that the saved files are sometimes empty or nearly empty.
Plain text files contain just "Subject:" and a line break, RTF files display
blank and contain the following, which I guess might be an empty paragraph:
{\rtf1\ansi\ansicpg1252\deff0\deflang1031{\fonttbl{\f0\fswiss\fprq2\fcharset0
System;}}
\viewkind4\uc1\pard\b\f0\fs20\par
}
The HTML format works correctly with my test messages.
I did most tests with OL 2000 SR-1(9.0.0.3821) in Corporate or Workgroup
mode (working offline with no connection to an Exchange server), however I
can reproduce the problem with OL 2003 (11.6568.6568) SP2. While most of the
real .msg files will have attachments, I can reproduce the issue without
them. Part of the files were saved from outlook's drafts folder and thus
haven't been sent yet. OS: Win XP Pro SP2 with OL 2000, Win XP Home 5.1.2600
SP2 with OL2003.
The problem doesn't occur when using outlook's MailItem.SaveAs (see test
script below), which triggers the security prompt in OL2003.
I unsuccessfully searched this group and some others. Anyone who can help?
Below I post a test vb-script to show what I'm trying to do. (I added
olMsg.SafeItem just for demonstration.) Am I doing anything wrong?
TIA,
alb
- - 8< - -
' Test script for SaveAs method
' usage: drop .msg file on script
' or pass full path on the command line
Option Explicit
Const olEditorHTML = 2
Const olEditorRTF = 3
Const olEditorText = 1
Const olEditorWord = 4
Const ol_RTF = 1
Const ol_HTML = 5
Const ol_TXT = 0
Const olFormatHTML = 2
Const olFormatPlain = 1
Const olFormatRichText = 3
Const olFormatUnspecified = 0
Dim source
Dim fso
set fso = createobject("scripting.filesystemobject")
if wscript.arguments.count = 1 then
source = wscript.arguments.item(0)
end if
if not fso.fileexists(source) then
wscript.quit
end if
print source
Dim olMsg 'Outlook.MailItem
Dim olAttachment 'Outlook.Attachment
Dim olSafeMsg ' Redemption.SafeMailItem
Dim privOlApp
Dim privOlNs
Set olSafeMsg = CreateObject("Redemption.SafeMailItem")
Set privOlApp = CreateObject("Outlook.Application")
Set privOlNs = privOlApp.GetNamespace("MAPI")
privOlNs.Logon
print "open message"
Set olMsg = privOlApp.CreateItemFromTemplate(source)
olSafeMsg.Item = olMsg
Dim MailFileName
Dim MailFileBase
Dim MailPathBase
MailFileName = fso.GetBaseName(Source)
MailPathBase = fso.BuildPath(fso.GetParentFolderName(Source), MailFileName)
Dim Format
Format = BodyFormat(olSafeMsg)
Dim MailPath
Dim MailPathOL
Select Case Format
Case olFormatRichText
MailPath = MailPathBase & ".rtf"
MailPathOL = MailPathBase & "_OL.rtf"
print MailPath
olSafeMsg.SaveAs MailPath, ol_RTF ' olRTF = 1
print MailPathOL
olMsg.SaveAs MailPathOL, ol_RTF ' olRTF = 1
Case olFormatHTML
MailPath = MailPathBase & ".html"
MailPathOL = MailPathBase & "_OL.html"
print MailPath
olSafeMsg.SaveAs MailPath, ol_HTML ' olHTML = 5
print MailPathOL
olMsg.SaveAs MailPathOL, ol_HTML
Case olFormatPlain
MailPath = MailPathBase & ".txt"
MailPathOL = MailPathBase & "_OL.txt"
print MailPath
olSafeMsg.SaveAs MailPath, ol_TXT ' olTXT = 0
print MailPathOL
olMsg.SaveAs MailPathOL, ol_TXT
Case Else
print "unknown format"
MailPath = MailPathBase & ".txt"
MailPathOL = MailPathBase & "_OL.txt"
print MailPath
olSafeMsg.SaveAs MailPath, ol_TXT ' olTXT = 0
print MailPathOL
olMsg.SaveAs MailPathOL, ol_TXT
End Select
Function BodyFormat(olMsg)
On Error Resume Next
Dim EditorType
BodyFormat = -1
BodyFormat = olMsg.BodyFormat
If Err.Number = 438 Then ' Object doesn't support this property or method
BodyFormat = -1
Err.Clear
ElseIf Err.Number <> 0 Then
on error goto 0
Err.Raise Err.Number, Err.Source, Err.Description
End If
If BodyFormat = -1 Then
print "BodyFormat: Property BodyFormat is not available, checking
olMsg.GetInspector.EditorType"
EditorType = olMsg.GetInspector.EditorType
print "BodyFormat: EditorType = " & CStr(EditorType)
Select Case EditorType
Case olEditorHTML
BodyFormat = olFormatHTML
Case olEditorRTF
BodyFormat = olFormatRichText
Case olEditorText
BodyFormat = olFormatPlain
Case Else
DebugLog vbTab & "BodyFormat: Unknown EditorType " &
olMsg.GetInspector.EditorType & " -- defaulting to " & olFormatPlain
BodyFormat = olFormatPlain
End Select
End If
end function
sub print(s)
wscript.echo s
end sub
I work on a VB app that opens .msg files and saves them as either plain
text, HTML or RTF files, depending on the message format. To bypass the
security prompt in Outlook 2003, I use Outlook Redemption 4.1.0.507. I need
to support both Outlook 2000 and 2003.
The problem is that the saved files are sometimes empty or nearly empty.
Plain text files contain just "Subject:" and a line break, RTF files display
blank and contain the following, which I guess might be an empty paragraph:
{\rtf1\ansi\ansicpg1252\deff0\deflang1031{\fonttbl{\f0\fswiss\fprq2\fcharset0
System;}}
\viewkind4\uc1\pard\b\f0\fs20\par
}
The HTML format works correctly with my test messages.
I did most tests with OL 2000 SR-1(9.0.0.3821) in Corporate or Workgroup
mode (working offline with no connection to an Exchange server), however I
can reproduce the problem with OL 2003 (11.6568.6568) SP2. While most of the
real .msg files will have attachments, I can reproduce the issue without
them. Part of the files were saved from outlook's drafts folder and thus
haven't been sent yet. OS: Win XP Pro SP2 with OL 2000, Win XP Home 5.1.2600
SP2 with OL2003.
The problem doesn't occur when using outlook's MailItem.SaveAs (see test
script below), which triggers the security prompt in OL2003.
I unsuccessfully searched this group and some others. Anyone who can help?
Below I post a test vb-script to show what I'm trying to do. (I added
olMsg.SafeItem just for demonstration.) Am I doing anything wrong?
TIA,
alb
- - 8< - -
' Test script for SaveAs method
' usage: drop .msg file on script
' or pass full path on the command line
Option Explicit
Const olEditorHTML = 2
Const olEditorRTF = 3
Const olEditorText = 1
Const olEditorWord = 4
Const ol_RTF = 1
Const ol_HTML = 5
Const ol_TXT = 0
Const olFormatHTML = 2
Const olFormatPlain = 1
Const olFormatRichText = 3
Const olFormatUnspecified = 0
Dim source
Dim fso
set fso = createobject("scripting.filesystemobject")
if wscript.arguments.count = 1 then
source = wscript.arguments.item(0)
end if
if not fso.fileexists(source) then
wscript.quit
end if
print source
Dim olMsg 'Outlook.MailItem
Dim olAttachment 'Outlook.Attachment
Dim olSafeMsg ' Redemption.SafeMailItem
Dim privOlApp
Dim privOlNs
Set olSafeMsg = CreateObject("Redemption.SafeMailItem")
Set privOlApp = CreateObject("Outlook.Application")
Set privOlNs = privOlApp.GetNamespace("MAPI")
privOlNs.Logon
print "open message"
Set olMsg = privOlApp.CreateItemFromTemplate(source)
olSafeMsg.Item = olMsg
Dim MailFileName
Dim MailFileBase
Dim MailPathBase
MailFileName = fso.GetBaseName(Source)
MailPathBase = fso.BuildPath(fso.GetParentFolderName(Source), MailFileName)
Dim Format
Format = BodyFormat(olSafeMsg)
Dim MailPath
Dim MailPathOL
Select Case Format
Case olFormatRichText
MailPath = MailPathBase & ".rtf"
MailPathOL = MailPathBase & "_OL.rtf"
print MailPath
olSafeMsg.SaveAs MailPath, ol_RTF ' olRTF = 1
print MailPathOL
olMsg.SaveAs MailPathOL, ol_RTF ' olRTF = 1
Case olFormatHTML
MailPath = MailPathBase & ".html"
MailPathOL = MailPathBase & "_OL.html"
print MailPath
olSafeMsg.SaveAs MailPath, ol_HTML ' olHTML = 5
print MailPathOL
olMsg.SaveAs MailPathOL, ol_HTML
Case olFormatPlain
MailPath = MailPathBase & ".txt"
MailPathOL = MailPathBase & "_OL.txt"
print MailPath
olSafeMsg.SaveAs MailPath, ol_TXT ' olTXT = 0
print MailPathOL
olMsg.SaveAs MailPathOL, ol_TXT
Case Else
print "unknown format"
MailPath = MailPathBase & ".txt"
MailPathOL = MailPathBase & "_OL.txt"
print MailPath
olSafeMsg.SaveAs MailPath, ol_TXT ' olTXT = 0
print MailPathOL
olMsg.SaveAs MailPathOL, ol_TXT
End Select
Function BodyFormat(olMsg)
On Error Resume Next
Dim EditorType
BodyFormat = -1
BodyFormat = olMsg.BodyFormat
If Err.Number = 438 Then ' Object doesn't support this property or method
BodyFormat = -1
Err.Clear
ElseIf Err.Number <> 0 Then
on error goto 0
Err.Raise Err.Number, Err.Source, Err.Description
End If
If BodyFormat = -1 Then
print "BodyFormat: Property BodyFormat is not available, checking
olMsg.GetInspector.EditorType"
EditorType = olMsg.GetInspector.EditorType
print "BodyFormat: EditorType = " & CStr(EditorType)
Select Case EditorType
Case olEditorHTML
BodyFormat = olFormatHTML
Case olEditorRTF
BodyFormat = olFormatRichText
Case olEditorText
BodyFormat = olFormatPlain
Case Else
DebugLog vbTab & "BodyFormat: Unknown EditorType " &
olMsg.GetInspector.EditorType & " -- defaulting to " & olFormatPlain
BodyFormat = olFormatPlain
End Select
End If
end function
sub print(s)
wscript.echo s
end sub