The issue was: creating a server-side solution for exporting emails to EML file from different mailboxes.
The application has a settings view, where the key user can set up different mail boxes for exporting.
This is cluster ready application.
This is cluster ready application.
 |
| Settings |
Here comes the important part of the code.
function exportEML As Boolean
On Error GoTo ErrHdl
Dim fileNum As Integer
Dim mime As NotesMIMEEntity
Dim stream As NotesStream
Dim evalstr As String
Dim tmp As Variant
Dim expFileName As String
Dim mimeType As String
Dim mimeBoundAryStart As string
Dim mimeBoundAryEnd As string
ss.Convertmime = False
fileNum% = FreeFile()
Set mime = maildoc.GetMIMEentity
If mime Is Nothing Then
Call maildoc.ConvertToMIME(3)
Set mime = maildoc.GetMIMEentity
End If
If Not mime Is Nothing Then
Set stream = ss.Createstream()
expFileName$ = wDir & "\" & maildoc.Universalid & ".eml" ...
If Dir$(expFileName$) <> "" Then
Kill expFileName$ ...
End If
Call stream.Open(expFileName$, mime.Charset)
...
mimeType = mime.Contenttype
mimeBoundAryStart = mime.Boundarystart
mimeBoundAryEnd = mime.Boundaryend
Call mime.GetEntityAsText(stream)
Set mime = mime.GetNextEntity
While Not mime Is Nothing
Call stream.Writetext("", 3)
Call stream.Writetext(mime.BoundAryStart)
Call mime.DecodeContent()
Call mime.Encodecontent( 1727 )
Call mime.GetentityAsText(stream)
Call stream.Writetext(mime.BoundAryEnd)
Set mime = mime.GetNextEntity
Wend
Call stream.WriteText(mimeBoundAryEnd)
Call stream.Close()
...
exportEML = True
Else
...
exportEML = False
End If
ErrHdl:
If Err Then
Print " Error @ " & db.Filename & " (" & db.Title & ") - " & ag.Name & " - 'function exportEml' (" & Err & ") " & Error & " - line: " & Erl
exportEML = false
Exit Function
End If
End Function
Great. That Works!
ReplyDeleteThanx
Here a complete Agent for Client use on selected Documents.
ReplyDeleteJust change wDir to your path.
Option Public
Option Explicit
Dim session As NotesSession
Dim wDir As String
Sub Initialize
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim dc As NotesDocumentCollection
Set session= New NotesSession
Set db= session.CurrentDatabase
Set dc= db.UnprocessedDocuments
Set doc= dc.GetFirstDocument
wDir= "D:\Temp\Notes-Inbox\"
Do Until doc Is Nothing
If Not exportEML(doc) Then
Print "Not saved: " & doc.Subject(0)
End If
Set doc= dc.GetNextDocument(doc)
Loop
End Sub
Function exportEML(maildoc As NotesDocument) As Integer
On Error Goto ErrHdl
Dim mime As NotesMIMEEntity
Dim stream As NotesStream
Dim tmp As Variant
Dim expFileName As String
Dim mimeType As String
Dim mimeBoundAryStart As String
Dim mimeBoundAryEnd As String
session.Convertmime= False
Set mime= maildoc.GetMIMEentity
If mime Is Nothing Then
Call maildoc.ConvertToMIME(3)
Set mime= maildoc.GetMIMEentity
End If
If Not mime Is Nothing Then
Set stream= session.Createstream()
expFileName= wDir & maildoc.UniversalID & ".eml"
If Dir$(expFileName) <> "" Then
Kill expFileName
End If
Call stream.Open(expFileName, mime.Charset)
mimeType= mime.Contenttype
mimeBoundAryStart= mime.Boundarystart
mimeBoundAryEnd= mime.Boundaryend
Call mime.GetEntityAsText(stream)
Set mime= mime.GetNextEntity
While Not mime Is Nothing
Call stream.Writetext("", 3)
Call stream.Writetext(mime.BoundAryStart)
Call mime.DecodeContent()
Call mime.Encodecontent( 1727 )
Call mime.GetentityAsText(stream)
Call stream.Writetext(mime.BoundAryEnd)
Set mime= mime.GetNextEntity
Wend
Call stream.WriteText(mimeBoundAryEnd)
Call stream.Close()
exportEML= True
End If
ErrHdl:
If Err Then
Print " Error @ " & " - 'function exportEml' (" & Err & ") " & Error & " - line: " & Erl
Exit Function
End If
End Function