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.
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
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!
Anbei die Lösung für mein Problem (entstanden durch Modifikation von im Netz gefundenen Code):
Betreff + Aufruf:
'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:
'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.