Lotus Notes Entwurf aus Excel

[Matthias2]

Hallo zusammen,
ich möchte gerne Daten direkt aus Excel versenden. Die u.g. Routine habe ich aus einer Excel-Newsgroup bekommen. Leider konnte mir niemand sagen, wie ich den u.g. Code modifizieren muss, um statt einer fertigen Mail (die auch abgeschickt wird) einen Mail-Entwurf generieren kann. Ich möchte die Datei, die ich anhänge, vorher nochmal auf Fehler prüfen, bevor ich die Daten rausschicke.
Vielen Dank im Voraus
Matthias


Public Sub SendNotesMail2(MailTo As String, MailText As String, MailAnhang As String, MailAbsender As String, MailBetreff As String, MailSenden As Boolean, Receipt As Boolean)
'
' 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
Dim i As Integer


    '
    ' 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)
    '
    For i = 0 To EmpfCnt
   
    Set NotesDoc = NotesDB.CreateDocument
    With NotesDoc
        .Form = "Memo"
        .Subject = MailBetreff
        .sendto = EmpfListe(i)
        '.copyto = ' Kopie an
        '.blindcopyto= Blindkopie an
        .body = MailText & vbCrLf & MailAbsender
        '.DefaultMailSaveOption = 0
        '.MailSaveOption = 0
        .DeliveryReport = "B"
        .Importance = "2"
        '.logo = "Scania"
        .SAVEMESSAGEONSEND = True ' bei True wird ein Exemplar in Notes in Gesendet gestellt
        If Receipt Then
            .ReturnReceipt = "1"
        Else
            .ReturnReceipt = "0"
        End If
        .Sign = "1"
        '.encrypt ="0"
        '.Principal = session.UserName
        '.viewicon ="74"
        '.from = session.UserName
        '.SaveOptions = 0
        '.SecureMail = ""
        '.SenderTag = "F"

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

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

''''''''''''''''''''''''''''''''''''''''''
       
        If MailSend Then
           .send True
        Else
           .send False
           .Save True
        End If
    End With
    Set NotesDoc = Nothing
    Next

    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

[eknori]

Setze mal PostedDate auf "". Das sollte es schon tun ...

also statt

With NotesDoc
        .Form = "Memo"


With NotesDoc
        .PostedDate = ""
        .Form = "Memo"

[koehlerbv]

Moment - das NotesDoc.Send muss natürlich auch noch 'raus, sonst isses ja doch wech, das Mail.
Ausserdem ist mir auf die schnelle aufgefallen: Der Parameter heisst MailSenden, verwendet wird aber MailSend.

Bernhard

[Matthias2]

Hallo zusammen,
vielen Dank schonmal für die schnelle Hilfe. Ich habe beide Tipps mal in das Makro eingebaut. Leider läuft es noch nicht.

Der untere Part sieht jetzt so aus.

 If MailSenden Then
           .send True
        Else
           .Save True
 End If

Zumindest wird jetzt keine Mail mehr verschickt, aber leider bekomme ich auf das ".Save" eine "Typen unverträglich"-Meldung und finde im Anschluss auch keine gespeicherte Mail in meinen Entwürfen.

Gibt es noch etwas anzupassen.
Vielen Dank schonmal
Matthias

[koehlerbv]

Fehlt vor dem NotesDocument.Save nicht noch ein Call ? Oder ist VBA da grosszügig ?
Weiterhin fehlt ein Parameter für den Aufruf:
Call NotesDocument.Save (True, False) oder - je nach Gusto -
Call NotesDocument.Save (True, True)

Bernhard

PS: Ich habe das jetzt nicht unter VBA getestet.

[Matthias2]

Hallo Bernhard,

Call NotesDocument.Save (True, False)
und
Call NotesDocument.Save (True, True)


erzeugt jeweils die Fehlermeldung "Objekt erfoderlich". Wenn ich aber nur

If MailSenden Then
           .send True
        Else
           .Save True, False
End If

schreibe, dann funktioniert es!
   

Vielen Dank!
Gruß
Matthias

[koehlerbv]

Wenn Du natürlich NotesDocument geschrieben hast, dann muss das auch in die Hose gegangen sein - ich habe damit nur die Klasse erneut genannt. Nach der bei Dir verwendeten Notation muss das natürlich 'raus - Dein zugehörigen Objekt heisst "NotesDoc", und Du arbeitest bereits mit "With".

Bernhard