Excel-Datei an Notes anhängen, Zellen zusätzlich einfügen, aber nicht versenden

[Raphael]

Hallo zusammen,
ich hoffe das Problem hier an der richtigen Stelle anzubringen.

Folgende Situation (Excel 2007, Lotus Notes 6.5):
Ich arbeite mit einem größeren Excel-File, welches bei Drücken der Versende-Schaltfläche folgende Aktionen ausführen soll:

I. ein Notes-Memo erstellen (   )
II. einen vorher definierten Bereich aus Excel als Bild einfügen (   )
III. die aktuelle Excel-Datei anhängen (   )
IV. die Email nicht direkt versenden, da der Empfänger per Hand eingegeben werden muss und manchmal weitere Dateien angehangen werden müssen ( )

Wie den Smileys zu entnehmen ist, bereitet mir Punkt III. einiges Kopfzerbrechen.

Code

Dim Notes As Object
Dim Maildb As Object
Dim WorkSpace As Object
Dim UIdoc As Object
Dim UserName As String
Dim MailDbName As String

Set Notes = CreateObject("Notes.NotesSession")
UserName = Notes.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Notes.GetDataBase(vbNullString, MailDbName)
Set WorkSpace = CreateObject("Notes.NotesUIWorkspace")
Call WorkSpace.ComposeDocument(, , "Memo")
Set UIdoc = WorkSpace.CurrentDocument


'If cells are null, such as email address, cc, etc, then ignore and dont paste into email
On Error Resume Next
 
'Note:  Addresses in this cell should be separated by a semicolon.
Recipient = "Bitte Empfänger eingeben"
Call UIdoc.FieldSetText("EnterSendTo", Recipient)
 
'Note:  Addresses in this cell should be separated by a semicolon
ccRecipient = ""
Call UIdoc.FieldSetText("EnterCopyTo", ccRecipient)
 
'Note:  Addresses in this cell should be separated by a semicolon
bccRecipient = ""
Call UIdoc.FieldSetText("EnterBlindCopyTo", bccRecipient)
 
'Copy the subject from cell P13 into the SUBJECT: field in Lotus Notes
Subject1 = Sheets("BESTELLANTRAG").Range("P13").Value
Call UIdoc.FieldSetText("Subject", Subject1)

'Copy the cells in the range into the BODY in Lotus Notes.
Set rnBody = ActiveSheet.Range("B53:K63") 
rnBody.Copy
Call UIdoc.GotoField("Body")
Call UIdoc.Paste

'Insert some carriage returns at the end of the email
Call UIdoc.InsertText(vbCrLf & vbCrLf)
Application.CutCopyMode = False
 
Set UIdoc = Nothing: Set WorkSpace = Nothing
Set Maildb = Nothing: Set Notes = Nothing
Set Body = Nothing

http://www.ozgrid.com/forum/showthread.php?t=99798

Ich habe mich jetzt bereits einige Tage damit auseinandergesetzt und mir einige Lösungsmöglichkeiten bzgl. Dateianhängen angesehen, doch hatten diese immer den Nachteil, dass die Email anschließend umgehend versendet wurde, was im Hinblick auf IV. nicht sein darf.

Für Ratschläge und Hilfestellungen wäre ich sehr dankbar!

[koehlerbv]

Genauso, wie Du Dein Bild einfügst, kannst Du es auch mit dem Sheet als Attachment machen. Du solltest dabei über ein persönliches ProfileDocument gehen (RT-Item löschen, neu erstellen, attachen, im UI öffnen und kopieren).

HTH,
Bernhard

[Raphael]

ah..........ok.... Ich versteh zwar quasi noch größtenteils Bahnhof, aber ich werde mal google konsultieren 
Schonmal vielen Dank!

[koehlerbv]

Sag einfach an, was noch unverständlich ist.

Bernhard

[Raphael]

Als totaler Laie hört es schon mit persönliches ProfileDocument, RT-Item etc. auf. Ich versuche seit einigen Tagen mich anhand von Codefragmenten in die Thematik einzuarbeiten. Falls es eine frei verfügbare, einführende Doku für das Thema gibt, wär ich für einen Link oder Namen dankbar

[koehlerbv]

Die Doku ist die mit dem Domino Designer mitgelieferte DesignerHelp.

- Persönliches ProfileDocument: ProfileDocument mit verwendetem Parameter "Username", das immer nur dem jeweiligen Benutzer zur Verfügung steht (damit können nicht mehrere Anwender sich gegenseitig Sachen überschreiben)
- RT-Item: NotesRichTextItem

Ad "totaler Laie": Wo hast Du denn dann Deinen gegenwärtigen Code her??

Bernhard

[Raphael]

Die Doku ist die mit dem Domino Designer mitgelieferte DesignerHelp.

- Persönliches ProfileDocument: ProfileDocument mit verwendetem Parameter "Username", das immer nur dem jeweiligen Benutzer zur Verfügung steht (damit können nicht mehrere Anwender sich gegenseitig Sachen überschreiben)
- RT-Item: NotesRichTextItem

danke

Ad "totaler Laie": Wo hast Du denn dann Deinen gegenwärtigen Code her??

Sorry, ich dachte das hätte ich auch geschrieben, aber wo du es sagst. Das ist von einer der vielen Seiten, die mir Google dazu geliefert hat und mit deren Codefragmenten ich rumexperimentiert habe. Sobald ich nochmal auf die Seite stoße, werde ich im ersten Posting eine Referenz einfügen.

UPDATE: Link oben eingefügt (http://www.ozgrid.com/forum/showthread.php?t=99798)

[Raphael]

Anbei die Lösung für mein Problem (entstanden durch Modifikation von im Netz gefundenen Code):

Betreff + Aufruf:

Code

'Dieser Bereich speichert den später benötigten bzw. eingefügten Email-Betreff und übergibt ihn mit dem Aufruf
Dim Subject1 As String
Subject1 = Sheets("BESTELLUNG").Range("P13").Value

Call CreateMailandAttachFileAdr(Subject1)

Hauptcode in separatem Modul:

Code

'Option Compare Database
Option Explicit

'########################################################################

' Author: Klaus Oberdalhoff
' I used several scripts i found on the internet

'########################################################################

Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ShowWindow& Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long)
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Function CreateNotesSession&()
Const notesclass$ = "NOTES"
' "Neues Memo - Lotus Notes"
Const SW_SHOWMAXIMIZED = 3
Dim Lotus_Session As Object

Dim rc&
Dim lotusWindow&
Set Lotus_Session = CreateObject("Notes.NotesSession")

DoEvents
DoEvents
lotusWindow = FindWindow(notesclass, vbNullString)
If lotusWindow <> 0 Then
    rc = ShowWindow(lotusWindow, SW_SHOWMAXIMIZED)
    rc = SetForegroundWindow(lotusWindow)
    CreateNotesSession& = True
Else
    CreateNotesSession& = False
End If
End Function

Sub CreateMailandAttachFileAdr(Optional IsSubject As String, Optional SendToAdr As String, Optional CCToAdr As String, Optional BCCToAdr As String = "", Optional Attach1 As String = "", Optional Attach2 As String = "")

Const EMBED_ATTACHMENT As Integer = 1454
Const EMBED_OBJECT As Integer = 1453
Const EMBED_OBJECTLINK As Integer = 1452

Dim s As Object ' use back end classes to obtain mail database name
Dim db As Object '
Dim doc As Object ' front end document
Dim beDoc As Object ' back end document
Dim workspace As Object ' use front end classes to display to user
Dim bodypart As Object
Dim stAttachment As String

Call CreateNotesSession&

Set s = CreateObject("Notes.Notessession") 'create notes session
Set db = s.getDatabase("", "") 'set db to database not yet named
Call db.Openmail ' set database to default mail database
Set beDoc = db.CreateDocument
Set bodypart = beDoc.CreateRichTextItem("Body")

beDoc.Subject = IsSubject
beDoc.SendTo = "Empfänger bitte eingeben"
beDoc.CopyTo = ""
beDoc.BlindCopyTo = ""

' Auswahl des Anhangs, in diesem Fall der aktuell genutzten Excel-Datei
stAttachment = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
Call bodypart.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)


Set workspace = CreateObject("Notes.NotesUIWorkspace")


'Copy the cells in the range into the BODY in Lotus Notes.
Dim rnBody As Object
Set rnBody = Sheets("BESTELLUNG").Range("B53:K63")  '<- Bereich, der im Notes angezeigt wird
rnBody.Copy
Call workspace.EditDocument(True, beDoc).GotoField("Body")
Call workspace.EditDocument.Paste

Set s = Nothing

End Sub

Ich hoffe dies hilft bei Zeiten noch jemandem.