|
'######################################################################################
'
Application.Dialogs(xlDialogSendMail).Show _
' Empfaenger, Betreff
On Error Resume Next
'# MAIL VORBEREITEN
################################################################
'MsgBox ("Bitte achten Sie darauf,
dass in Notes keine popups geöffnet sind wie z.B.: ' _
Sie haben eine neue Mail erhalten'")
'MsgBox ("Bei einer Fehlermeldung
bitte auf 'Beenden' klicken." & VBA.Chr(13) & "Die _
Mail wird trotzdem vorbereitet."
& VBA.Chr(13) & VBA.Chr(13) & "Danke")
'Variablen Dimensionieren, die benötigt
werden, um das Mail zu senden
Dim mRows As Integer
Dim mCols As Long
Dim Maildb As Object
'Die Datenbank
Dim UserName As String 'Der Benutzername
Dim MailDbName As String 'Der
Datenbankname
Dim MailDoc As Object 'Das Maildokument selbst
Dim AttachME As Object 'Der Anhang (Richtext)
Dim Session As Object 'Die Notes Session
Dim EmbedObj As Object 'Ein eingebettetes Objekt (Anhang)
Dim ClipBoard
As DataObject
Dim SaveIt As Boolean
Dim Subject As String
Dim Attachment1 As String
Dim Attachment2 As String
Dim Recipient As String
Dim cc As String
Dim BodyText As String
Subject = "Erläuterungen "
Recipient = Empfaenger
cc = "Abteilung"
Attachment = ThisWorkbook.Path & "\" & Dateiname
'Attachment2 = "C:\Pfad\Datei2.pdf"
BodyText = ThisWorkbook.Sheets("ExcelBlatt").Cells(229,
4).Value 'Chr(13) & Chr(13) & Chr(13) & "Hallo," &
Chr(13) & "Im Anhang findest du die aktuelle Vorlage Zahlen." & Chr(13) & ""
Dim filename As String
Dim numrows As Long
Dim numcols As Integer
Dim r As Long
Dim c As Integer
Dim data
Dim exprng As Range
Set exprng = Selection
numcols = exprng.Columns.Count
numrows = exprng.Rows.Count
'Die Session starten
Set Session = CreateObject("Notes.NotesSession")
'Den Benutzernamen auslesen
und den Dateinamen
'der MailDB errechnen
'Dies wird nicht überall benötigt.
Auf manchen
'Systemen kann auch ein leerer String
übergeben werden
UserName = Session.UserName
'MailDbName = Left$(UserName, 1)
& Right$(UserName, (Len(UserName) _
- InStr(1, UserName, " ")))
& ".nsf"
MailDbName = "mail\saog.nsf"
'Datenbank öffnen
Set Maildb =
Session.GETDATABASE("", MailDbName)
If Maildb.IsOpen = True Then
'Fertig zum mailen!
Else
Maildb.OPENMAIL
End If
'Ein neues Maildokument erstellen
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
MailDoc.sendto = Recipient & ", " & cc
MailDoc.Subject = Subject
MailDoc.body = BodyText
MailDoc.SAVEMESSAGEONSEND = SaveIt
'Eingebettete Objekte und Anhänge hinzufügen
If Attachment <> "" Then
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
Set EmbedObj =
AttachME.EMBEDOBJECT(1454, "", Attachment, _
"Attachment")
'MailDoc.CREATERICHTEXTITEM
("Attachment")
End If
If Attachment2 <> "" Then
Set AttachME =
MailDoc.CREATERICHTEXTITEM("Attachment")
Set EmbedObj =
AttachME.EMBEDOBJECT(1454, "", Attachment2, _
"Attachment")
'MailDoc.CREATERICHTEXTITEM
("Attachment")
End If
Dim Workspace As Object
Set Workspace = CreateObject("Notes.NOTESUIWORKSPACE")
Call Workspace.editdocument(True, MailDoc).GOTOFIELD("Body")
' MsgBox ("Die Mail
wurde erstellt")
'Aufräumen
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Noth
Set Session = Nothing
Set EmbedObj =
Nothing
'######################################################################################
|