View Single Post
  #1  
Old August 3rd 06, 11:00 AM posted to microsoft.public.outlook.program_vba
Alexander Bub
external usenet poster
 
Posts: 3
Default Redemption's SafeMailItem.SaveAs method yields empty files

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




Ads