Schau dir mal das an, ich hab das aus verschiedenen Einträgen zusammen geschrieben und es funktioniert bei mir ganz gut.
Man kann direkt versenden aber auch nur anzeigen, damit der User den Senden Button drücken kann. Ebenfalls kann ausgewählt werden ob die Mail gespeichert werden soll oder nicht.
Auch kann unterschieden werden ob die Email im Notes RTF Format oder als HTML gesendet werden soll.
Koper einfach alles in ein neues VB Modul, tausche die Mailadresse in der "NotesMail_Test" Sub aus und starte die "NotesMail_Test" Sub.
Wenn Jemand noch Ideen dazu hat, melden!
Gruß
muR
________________________________________________________________________________
Attribute VB_Name = "NotesMail"
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Type Mail
Send As Boolean 'True = Email senden, Default = True
To As String 'Empfängeradressen
CC As String 'CC Adressen
BCC As String 'BCC Adressen
Sub As String 'Betreffzeile
Body As String 'Standard Bodytext
Att As String 'Attachments as String, mit Komma getrennt
Save As Boolean 'True = Email ablegen in Ordner gesendet, Default = True
ShowMsg As Boolean 'True = Aneigen der Meldungen der Sendfunktion, Default = False
Html As Boolean 'True = Erzeuge Bodytext als Html code, Default = False
End Type
Public myMail As Mail
Public Sub NotesMail_ReadINI(INI As String)
'Einträge in der INI Datei für die Mailfunktion
'[NotesMail]
'Notes.Mail.Send = 1
'Notes.Mail.To =
'Notes.Mail.CC =
'Notes.Mail.BCC =
'Notes.Mail.Sub =
'Notes.Mail.Body =
'Notes.Mail.Save = 1
'Notes.Mail.MsgS = 0
'Notes.Mail.Html = 0
'-------------------------------------------------------------
myMail.Send = GetINISet(INI, "NotesMail", "Notes.Mail.Send", "1")
myMail.To = GetINISet(INI, "NotesMail", "Notes.Mail.To", "")
myMail.CC = GetINISet(INI, "NotesMail", "Notes.Mail.CC", "")
myMail.BCC = GetINISet(INI, "NotesMail", "Notes.Mail.BCC", "")
myMail.Sub = GetINISet(INI, "NotesMail", "Notes.Mail.Sub", "")
myMail.Body = GetINISet(INI, "NotesMail", "Notes.Mail.Body", "")
myMail.Save = GetINISet(INI, "NotesMail", "Notes.Mail.Save", "1")
myMail.ShowMsg = GetINISet(INI, "NotesMail", "Notes.Mail.MsgS", "0")
myMail.Html = GetINISet(INI, "NotesMail", "Notes.Mail.Html", "0")
'Ersetze das Trennzeichen Semikollon zwischen den Emailadressen durch ein Komma
myMail.To = Replace(myMail.To, ";", ",")
myMail.CC = Replace(myMail.CC, ";", ",")
myMail.BCC = Replace(myMail.BCC, ";", ",")
End Sub
Public Function NotesMail_Senden()
With myMail
NotesMail_Senden = NotesMail_Send(.To, .CC, .BCC, .Sub, .Body, .Att, .Send, .Html, .Save, .ShowMsg)
End With
End Function
Public Sub NotesMail_Test()
Dim strTo, strSubject, strBody, strCC, strBCC As String
Dim strFiles As String
strTo = "Versand@TestOnline.de"
strSubject = "Versandinfo"
'Als RTF
'strBody = "Bitte beachten Sie ..." & vbCrLf & ",daß das ein Test ist"
'ALs Html
strBody = "<body><span style='font-weight: bold;'>Fett</span><br><br><table style='text-align: left; width: 100px;' border='1'cellpadding='2' cellspacing='2'><tbody><tr><td>a1</td><td>a2</td><td>a3</td></tr><tr><td>b1</td><td>b2</td><td>b3</td></tr></tbody></table></body>"
strBody = strBody & vbCrLf & vbCrLf
strFiles = "C:\boot.ini, C:\licenses.read" 'ActiveDocument.FullName
strCC = ""
strBCC = ""
NotesMail_Send strTo, strCC, strBCC, strSubject, strBody, strFiles
End Sub
Private Function NotesMail_Send(strTo As Variant, strCC As Variant, strBCC As Variant, _
strSubject As Variant, strBody As Variant, _
strFileNames As String, _
Optional Send As Boolean = True, _
Optional Html As Boolean = False, _
Optional SaveIt As Boolean = True, _
Optional ShowMsg As Boolean = False) As Boolean
' Dimensionierung der Objektvariablen
Dim objNotes As Object, objNotesDB As Object, objNotesMailDoc As Object
Dim SendItem, NCopyItem, BlindCopyToItem, i As Integer, rtitem
Dim Msg As String
Dim Attachments As Variant
NotesMail_Send = True
If Len(Trim(strSubject)) = 0 Then strSubject = "Mail - " & Date & " - " & Time
'Zuweisung der Objektvariablen
On Error GoTo ExitF
Set objNotes = GetObject("", "Notes.Notessession")
Set objNotesDB = objNotes.GETDATABASE("", "")
' Öffnen der Standard-Maildatenbank / Erstellen neues Maildokument
Call objNotesDB.OPENMAIL
If objNotesDB.IsOpen = False And ShowMsg = True Then
MsgBox "Bitte an Notes anmelden um diese Funktionnutzen zu können!", vbCritical + vbOKOnly
NotesMail_Send = False
Exit Function
End If
Set objNotesMailDoc = objNotesDB.CreateDocument
objNotesMailDoc.Form = "Memo"
Call objNotesMailDoc.Save(True, False)
Set SendItem = objNotesMailDoc.APPENDITEMVALUE("SendTo", "")
Set NCopyItem = objNotesMailDoc.APPENDITEMVALUE("CopyTo", "")
Set BlindCopyToItem = objNotesMailDoc.APPENDITEMVALUE("BlindCopyTo", "")
objNotesMailDoc.SendTo = Split(strTo, ",")
objNotesMailDoc.CopyTo = Split(strCC, ",")
objNotesMailDoc.BlindCopyTo = Split(strBCC, ",")
objNotesMailDoc.Subject = strSubject
'Seve Mail after send
objNotesMailDoc.SAVEMESSAGEONSEND = SaveIt
objNotesMailDoc.PostedDate = Now()
If Html = True Then
'Mailbody als html einfügen
objNotes.ConvertMime = False ' We do want Notes to convert MIME to Rich Text
Set rtitem = objNotesMailDoc.CreateMIMEEntity("Body")
Set stream = objNotes.CreateStream
Call stream.WriteText(strBody)
Call rtitem.SetContentFromText(stream, "text/html", ENC_QUOTED_PRINTABLE)
Call stream.Truncate
Else
'Mailbody als Notes RT item einfügen
Set rtitem = objNotesMailDoc.CREATERICHTEXTITEM("Body")
objNotesMailDoc.Body = strBody
rtitem.ADDNEWLINE (1)
End If
'Dateien anhängen
Const embed_ATT = 1454
Attachments = Split(strFileNames, ",")
Set rtitem = objNotesMailDoc.CREATERICHTEXTITEM("Attachments")
For x = LBound(Attachments) To UBound(Attachments)
If FileExists(Trim(Attachments(x))) Then Set EmbeddedObject = rtitem.EMBEDOBJECT(embed_ATT, "", Trim(Attachments(x)), "Attachments")
Next x
'Mail zustellen
If Send = True Then
Call objNotesMailDoc.Send(False)
Else
'Show new mail for edit and send by yourself
Set uiws = GetObject("", "Notes.NotesUIWorkspace")
Call uiws.EditDocument(True, objNotesMailDoc)
End If
On Error GoTo endF
If ShowMsg = True Then
'Nachricht an Benutzer
Msg = "Die E-Mail wurde erfolgreich versendet!"
MsgBox Msg, vbInformation, "Notesmail versenden..."
End If
'Objektvariablen zurücksetzen
objNotes.Close
objNotes.ConvertMime = True 'Reset the value (html format)
Set objNotes = Nothing
Set uiws = Nothing
Set objNotesDB = Nothing
Set objNotesMailDoc = Nothing
Set SendItem = Nothing
Set NCopyItem = Nothing
Set BlindCopyToItem = Nothing
Set rtitem = Nothing
Set stream = Nothing
Set uiws = Nothing
GoTo endF
ExitF:
If ShowMsg = True Then
Select Case Err.Number
Case -2147024894
MsgBox "Kann Notes bitte öffnen, bitte anmelden", vbCritical, "Error SendNotesMail"
Case Else
MsgBox "Err.Num:" & vbTab & Err.Number & vbCrLf & _
"Err.Des:" & vbTab & Err.Description, vbCritical, "Error SendNotesMail"
End Select
End If
NotesMail_Send = False
endF:
End Function
'Prüfen ob Datei existiert
'Die Funktion prüft die Extistenz einer beliebigen Datei und liefert den Wert True,
'wenn diese vorhanden ist bzw. False, wenn die Datei nicht gefunden werden konnte.
Private Function FileExists(ByVal sFile As String) As Boolean
'Der Parameter sFile enthält den zu prüfenden Dateinamen
Dim Size As Long
On Local Error Resume Next
Size = FileLen(sFile)
FileExists = (Err = 0)
On Local Error GoTo 0
End Function
Private Function GetINISet(ByVal FileName As String, ByVal Key As String, ByVal Setting As String, ByVal Default As Variant) As Variant
'Liest einen INI Schlüssel aus
Dim Temp As String * 1024
Call GetPrivateProfileString(Key, Setting, Default, Temp, Len(Temp), FileName)
GetINISet = Mid(Temp, 1, InStr(1, Temp, Chr(0)) - 1)
End Function
