In Notes Nachricht verschlüsseln per Access/vba

MrBentley · 31. März 2006

Hallo,

ich habe per Access ein vba Script erstellt, dass es mir ermöglicht eine Mail an mehrere Empfänger inkl. Berichte zu erstellen.

Leider habe ich Probleme mit dem verschlüsseln der Text-Nachricht. Es erscheint die Meldung "Sie können auf Teile dieses Dokuments zugreifen, da es verschlüsselt und nicht für Sie vorgesehen ist oder Sie nicht über den Entschlüsselungsschlüssel verfügen". Soweit so gut.

Jedoch kann ein Dritter den Nachrichtentext der Mail öffnen und lesen. Die Dateianhänge können jedoch nicht geöffnet werden.

Wie bekomme ich es hin, dass auch der Aufruf des Mailtextes unsichtbar ist.

Nachstehend der entscheidende Code. Die bisherige Verschlüsselung bewirken die Punkte "encrypt" und ""encryptonsend". Ich vermute ich muss noch irgendetwas mit seal anstellen -weiss aber nicht wie und was.

maildoc.seal="1" funktioniert nicht.

Wer kann mir weiterhelfen?

VG Christian

P.S. Bin Notes-Laie - komme eher aus dem Access Lager. Ich denke die Frage gehört aber eher hier hin.

Code

Set MailDoc = Maildb.CREATEDOCUMENT
                    MailDoc.Body = Mailtext                    
                    MailDoc.Form = "Memo"            
                    MailDoc.FROM = SessionNotes.USERNAME     
                    MailDoc.DefaultMailSaveOptions = "1" 
                    MailDoc.DeliveryPriority = "N"      
                    MailDoc.DeliveryReport = "B"    
                    MailDoc.Encrypt = "1"              
                    MailDoc.Importance = "2"         
                    MailDoc.Logo = "StdNotesLtr16"     
                    MailDoc.MailOptions = "0"      
                    MailDoc.MailSaveOptions = "1"      
                    MailDoc.OriginalModTime = Now()
                    MailDoc.Principal = SessionNotes.USERNAME
                    MailDoc.ReturnReceipt = ""         
                    MailDoc.SECUREMAIL = ""             
                    MailDoc.sendto = Notes_Mail         
                    MailDoc.SenderTag = ""           
                    MailDoc.Sign = ""                  
                    MailDoc.Subject = Betreff          
                    MailDoc.PostedDate = Now()         
                    MailDoc.SAVEMESSAGEONSEND = True
                    MailDoc.EncryptOnSend = True

Alles anzeigen

Der Gesamtcode basiert auf: http://www.kurt-aus-kienitz.de…/Module/MailPerNotes.html

MeinerEiner · 19. April 2006

Ich habe mir mal deinen Code etwas genauer betrachtet.
Mit ein paar Änderungen geht es. Damit das Body-Feld verschlüsselt wird, darfst Du es nicht mit .body hinzufügen, sondern musst es als rt anlegen.

Mit folgender Sub-Routine sollte auch die Verschüsselung funktionieren.

"
Sub SendNotesMail(MailTo As String, MailText As String, MailAnhang As String, _
MailAbsender As String, MailBetreff As String, _
Optional MailSenden = True)
'
' Versenden einer E-Mail via Lotus Notes.
'
' IN: MailTo E-Mail Adresse des Empfängers
' MailText Text der Nachricht
' MailAnhang Dateianhang (Dateiname mit Pfad)
' MailAbsender Name des Absenders (wird an den Text angeängt)
' MailBetreff Betreffzeile der E-Mail
' MailSenden True wenn Nachricht versendet werden soll,
' False wenn Nachricht als Entwurf gespeichert werden soll
'
Dim rtitem As Object
Dim EmbeddedObject As Object
Dim SessionNotes As Object, NotesDB As Object, NotesDoc As Object
Dim EmpfListe() As String
Dim EmpfCnt As Integer
Dim Pos1 As Long
'
' wenn die Betreffzeile leer ist, dann wird eine erzeugt
'
If Trim$(MailBetreff) = "" Then
MailBetreff = "Mail vom " & Date & " " & Time
End If
'
' Eigene Fehlerbehandlung
'
On Error GoTo Err_Mail_Click
'
' An die laufende Lotus Notes Session anhängen
'
Set SessionNotes = CreateObject("Notes.NOTESSESSION")
'
' Notes Datenbank-Objekt erstellen und initialisieren
'
Set NotesDB = SessionNotes.GetDatabase("", "")
NotesDB.OPENMAIL
If NotesDB.ISOPEN = False Then
MsgBox "Bitte melden Sie sich zunächst vollständig in Notes an!", vbInformation + vbOKOnly
Exit Sub
End If
'
' Empfängerliste erstellen
'
EmpfCnt = 0
Pos1 = InStr(MailTo, ";")
While Pos1 > 0
ReDim Preserve EmpfListe(EmpfCnt)
EmpfListe(EmpfCnt) = Left(MailTo, Pos1 - 1)
MailTo = Right(MailTo, Len(MailTo) - Pos1)
Pos1 = InStr(MailTo, ";")
EmpfCnt = EmpfCnt + 1
Wend
ReDim Preserve EmpfListe(EmpfCnt)
EmpfListe(EmpfCnt) = MailTo
'
' Neues Notes-Dokument anlegen (Mail)
'
Set NotesDoc = NotesDB.CreateDocument
With NotesDoc
.Subject = MailBetreff
.Sendto = EmpfListe
.SaveMessageOnSend = True
.SignOnSend = True
.EncryptOnSend = True
.ReturnReceipt = "1"

Set rtitem = .CreateRichTextItem("Body")
Call rtitem.AddNewLine(1)
Call rtitem.AppendText("Hello World")
Call rtitem.AddNewLine(1)
Call rtitem.AppendText(MailAbsender)

'''''''''''''' Dateianhang'''''''''''''''''

If Trim$(MailAnhang) <> "" Then
Const embed_ATT = 1454
Set EmbeddedObject = rtitem.EmbedObject(embed_ATT, "", MailAnhang, MailAnhang)
End If

''''''''''''''''''''''''''''''''''''''''''

If MailSenden Then
.Send False
Else
.Save True, True
End If
End With

Set SessionNotes = Nothing
Set NotesDB = Nothing
Set NotesDoc = Nothing
Set rtitem = Nothing
Set EmbeddedObject = Nothing

Exit_Mail_Click:
Exit Sub
Err_Mail_Click:
MsgBox Err.Description
Resume Exit_Mail_Click
End Sub
"

Gruss
MeinerEiner

Teilen