Hallo Forum,
ich verschicke aus Access 2010 per VBA Mails über IBM Notes 9.
Ich versuche formatierte Mails (unproportionale Schrift) mir anzeigen zu lassen, damit ich sie nach Sicht-Prüfung "Senden" kann.
Mein bisheriger Stand:
a) unformatiertes Mail anzeigen lassen - geht
b) formatiertes Mail versenden - geht
Wenn ich beides kombiniere, ist der Mailinhalt (body) leer.
Könnt Ihr mir bitte helfen?
Gruß Ingo
Mail-Funktion:
Function NotesMail_senden(strSendTo As String, _
strCopyTo As String, _
strBlindCopyTo As String, _
strSubject As String, _
strMessage As String, _
strAttachment As String, _
Optional bolSenden As Boolean = True)
On Error GoTo NotesMail_Err
Dim Workspace As Object
Dim NotesSession As Object
Dim NotesDatabase As Object
Dim NotesDocument As Object
Dim NotesRTStyle As Object
Dim NotesRTItem As Object
Dim NotesATTACHMENT As Object
Dim sMessage As String
' Session starten
Set NotesSession = CreateObject("Notes.Notessession")
' Create a new Style
Set NotesRTStyle = NotesSession.CreateRichTextStyle
' Verbindung zur Datenbank
Set NotesDatabase = NotesSession.GetDatabase("", "")
NotesDatabase.OpenMail
' Neues Dokument
Set NotesDocument = NotesDatabase.CreateDocument
' Neues NotesRichTextItem erstellen, Body im RichText formatieren
Set NotesRTItem = NotesDocument.CreateRichTextItem("Body")
' Anhang
If strAttachment <> "" Then Set NotesATTACHMENT = NotesRTItem.EMBEDOBJECT(1454, "", strAttachment, "Sample")
' Nachricht
sMessage = strMessage
' Nachricht formatieren
NotesRTStyle.NotesFont = 4 ' Courier
'NotesRTStyle.Bold = True ' Fett
NotesRTStyle.NotesColor = 2 ' Rot
NotesRTStyle.FontSize = 10 ' 10
Call NotesRTItem.AppendStyle(NotesRTStyle)
Call NotesRTItem.AppendText(sMessage)
' Formatierungen / Texte
With NotesDocument
.Form = "Memo"
.ReplaceItemValue "SendTo", strSendTo
.ReplaceItemValue "CopyTo", strCopyTo
.ReplaceItemValue "BlindCopyTo", strBlindCopyTo
.ReplaceItemValue "Subject", strSubject
' Senden / Gesendet anzeigen oder als Entwurf speichern
If bolSenden = True Then
.SAVEMESSAGEONSEND = True
.PostedDate = Now(): 'Im Postausgang wird die Mail sichtbar
.Send True
Else
Set Workspace = CreateObject("Notes.NotesUIWorkspace")
Call Workspace.EditDocument(True, NotesDocument).GotoField("Body") 'Positioning Cursor z.B. Subject o. Body
'Call .Save(True, False)
End If
End With
Set NotesRTItem = Nothing
Set NotesRTStyle = Nothing
Set NotesDocument = Nothing
Set NotesDatabase = Nothing
Set NotesSession = Nothing
'If bolSenden = True Then MsgBox "Mail wurde gesendet!", vbInformation Else MsgBox "Mail wurde gespeichert!", vbInformation
Exit Function
NotesMail_Err:
MsgBox Err.Description, vbExclamation, "Fehler! (" & Trim$(Str$(Err)) & ")"
End Function |