the below code resides in an agent.the agent when triggered will convert selected e-mails to mime files.
Code works well as long as the e-mails are 100% english. When you add some Japanese char to the e-mail the code bombs, giving the error of “Destination stream character set is incompatible with source”
What can one do to make this work no matter what language is there?
Dim ns As New NotesSession
Dim mimeDocCount As Integer
Dim strGetDUID As String
'On Error Goto HandleError
ns.ConvertMime = False
Set db = ns.CurrentDatabase
'This is where you need to change the URL to send to
strGetKey = "vKey"
Set profileView = db.GetView("LKProfile" )
Set profileDoc = profileView.GetDocumentByKey(strGetKey)
If Not (profileDoc Is Nothing) Then
strPushURL = Cstr(profileDoc.plURL(0))
Else
Messagebox("Unable to Locate Profile Doc, ask your Lotus Notes Administrator for Help!")
Exit Sub
End If
'Location of where files will be temporary stored
directory$ = jObject2.getUserDir()
Print "User DIR: " + directory$
'Start Hook on Selected Documents
Set dbCurrent = ns.CurrentDatabase
Set dcSelectedDocs = dbCurrent.UnprocessedDocuments
Set docExportDoc = dcSelectedDocs.GetFirstDocument()
strGetDUID = Cstr(docExportDoc.UniversalID)
'Count Selected Documents
mimeDocCount = 0
Set strmOutput = ns.CreateStream()
If (dcSelectedDocs Is Nothing) Then
Error 1000, {No Collection}
Elseif dcSelectedDocs.Count = 0 Then
Error 1001, {No documents selected}
End If
'Change strFileName to your preference.
strFileName = directory$ + "\" + docExportDoc.UniversalID + ".tmp"
Print "File Name: " + strFileName
Set MimeEntity = docExportDoc.GetMIMEEntity()
If Not strmOutput.Open(strFileName, MimeEntity.Charset) Then
Error 1002, { Cannot open file } + strFileName
End If
Do Until docExportDoc Is Nothing
Set MimeEntity = docExportDoc.GetMIMEEntity()
If (MimeEntity Is Nothing) Then
'No MIME on board.
Else
'We have MIME.
mimeDocCount = mimeDocCount + 1
Call GetMultipartMIME( MimeEntity, strmOutput, mimeDocCount, docExportDoc)
End If
Set docExportDoc = dcSelectedDocs.GetNextDocument( docExportDoc )
Loop
Call strmOutput.Close()
NormalExit:
ns.ConvertMime = True
'Delete File Created if Toggle = Yes
If(profileDoc.ToggleKillFile(0) = "Yes") Then
Kill (strFileName)
End If
Exit Sub
HandleError:
Dim strError$
strError$ = Error$ + Chr$( 13 ) + Chr$( 9 ) + "at " + Lsi_info( 2 )_
+ ":" + Cstr( Erl() )
Messagebox strError$, 0, "Error - #" + Cstr( Err() )
'Resume NormalExit
Exit Sub
Sub GetMultipartMIME(MimePart As NotesMimeEntity, Stream As NotesStream, passMimeDocCount As Integer, passDoc As NotesDocument )
'On Error Goto HandleError
Dim MimeChildEntity As NotesMimeEntity
Stream.WriteText(MimePart.BoundaryStart)
’ Make sure binary elements are encoded properly
If (MimePart.ContentType <> "text") Then
Call MimePart.EncodeContent( ENC_BASE64 )
End If
Call MimePart.GetEntityAsText( Stream )
Set MimeChildEntity = MimePart.GetFirstChildEntity()
’ If this part has any child parts, get them and all their descendants, too.
Do Until MimeChildEntity Is Nothing
Call GetMultipartMIME( MimeChildEntity, Stream, passMimeDocCount, docExportDoc)
Set MimeChildEntity = MimeChildEntity.GetNextSibling()
Loop
Stream.WriteText(MimePart.BoundaryEnd)
NormalExit:
Exit Sub
HandleError:
Dim strError$
strError$ = Error$ + Chr$( 13 ) + Chr$( 9 ) + "at " + Lsi_info( 2 )_
+ ":" + Cstr( Erl() )
Error Err(), strError$
End Sub