Exceldatei per Lotus an variable Empfänger senden

Hallo, liebe Excel/VBA-Experten !
Ich hoffe, jemand kann mir bei meinem Problem helfen, bei dem ich als VBA-Newbie
trotz Forensuche und Recherche leider nicht weiter komme...
Ich versende mit Hilfe eines gefundenen und modifizierten VBA-Makros ein einzelnes Excel-Tabellenblatt per Lotus Notes. Dabei müssen die E-Mailadressen der Empfänger und etwaige Empfänger einer Kopie fix/fest im Makro hinterlegt werden.
Dieser Abschnitt des Makros sieht etwa so aus:
Dim Recip(1) As Variant
Dim e As String
Dim f As String
Dim EmbedObj As Object
Dim AttachME As Object
Set session = CreateObject("Notes.NotesSession")
Set Maildb = session.CURRENTDATABASE
'On Error Resume Next
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
'(Bei mehreren Empfängern die Zahlen in den Klammern entsprechend hochzählen
'und die Zahl in der oberen Zeile "Dim Recip() as Variant entsprechend ändern)
Recip(1) ="anna.mustermann@web.de" hier Empfänger der Mail eingeben
MailDoc.sendto = Recip
MailDoc.CopyTo = "berta.mustermann@web.de" 'hier Empfänger der der Kopie eingeben
MailDoc.Subject = "Hier Betrefftext eingeben"
MailDoc.SAVEMESSAGEONSEND = True
u.s.w.
Ich möchte nun aber, daß die Empfangsadressen variabel aus einer Tabelle auf einem anderen Arbeitsblatt (Tabelle2) innerhalb der Arbeitsmappe ausgelesen werden und somit
das Tabellenblatt1 an die auf Tabellenblatt2 eingepflegten Adressen versendet wird.
Auf Tabellenblatt2 soll eine einfache Excel-Tabelle mit den E-Mailadressen stehen:
Empfänger: Kopie an:
anna.mustermann@web.de berta.mustermann@web.de
Wie muß bitte das Makro umgebaut werden, damit die E-Mailempfänger aus der variablen Tabelle
auf einem anderen Arbeitsblatt ausgelesen werden ?
Das übersteigt leider bei weitem meine allzu bescheidenen Learning-by-doing-Kenntnisse !
Es wäre toll, wenn jemand dazu einen Lösungsansatz oder auch eine alternative Lösung hätte.
Viele Grüße und einen schönen Abend !
Wolfgang

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub mail() Dim Empfaenger As String Dim rtitem As Object Dim EmbeddedObject As Object Dim Tosenden As String Dim CCsenden As String Dim Betreff As String Dim Text As String Dim Linkanhang As String Linkanhang = Worksheets("Tabelle2").Range("I15") 'anpassen DATEIANHANG = Linkanhang Tosenden = Worksheets("Tabelle2").Range("N2") 'anpassen CCsenden = Worksheets("Tabelle2").Range("N3") 'anpassen Betreff = Worksheets("Tabelle2").Range("M4") 'anpassen Text = Worksheets("Tabelle2").Range("M5") 'anpassen On Error GoTo Err_Mail_Click Dim SessionNotes As Object, NotesDB As Object, NotesDoc As Object Set SessionNotes = CreateObject("Notes.NOTESSESSION") 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 Set NotesDoc = NotesDB.CreateDocument With NotesDoc .Form = "Memo" .Subject = Betreff .sendto = Tosenden .copyto = CCsenden .body = Text .DeliveryReport = "B" .Importance = "2" .SAVEMESSAGEONSEND = True .ReturnReceipt = "1" .Sign = "1" ''''''''''''''''''''''''''''' Dateianhang''''''''''''''''''''''''''''''''''''''''''''''''''''''' _ If Trim$(DATEIANHANG) "" Then Const embed_ATT = 1454 Set rtitem = .CreateRichTextItem("DATEIANHANG") Set EmbeddedObject = rtitem.EmbedObject(embed_ATT, "", DATEIANHANG, "DATEIANHANG") End If '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' _ .Send False End With 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

Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _ (ByVal hWnd As Long, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nshowcmd As Long) As Long Sub Bild8_BeiKlick() Dim strToReceiver As String Dim strSubject As String Dim strBody As String Dim wbMail As Workbook, strAttachment As String, strPfad As String Dim visS As XlSheetVisibility Application.ScreenUpdating = False 'Blatt Daten kopieren und als Datei speichern With ActiveWorkbook strPfad = Environ("Userprofile") & "\Desktop" With .Worksheets("Daten") .Visible = xlSheetVisible .Copy .Visible = visS End With End With With ActiveWorkbook 'Dokumenteigenschaften setzen .BuiltinDocumentProperties("Title") = "Blatt Daten, Stand: " & Date .BuiltinDocumentProperties("Subject") = "Helvetia Action Tracking" 'Dokument im Excel 2003-Format speichern .SaveAs Filename:=strPfad & Application.PathSeparator _ & "Datenbank " & Format(Date, "YYYY-MM-DD"), FileFormat:=xlExcel7 strAttachment = .FullName .Close End With 'Lotus aufrufen strToReceiver = "vpmonitoring@helvetia.at" strSubject = "Helvetia Action Tracking" Call ShellExecute(0&, "Open", "mailto:" & strToReceiver _ & "?Subject=" & strSubject, "", "", 1) Application.ScreenUpdating = True End Sub

Hallo Fatih !
Einzelne Excel-Arbeitsblätter versende ich im Büro mit der folgenden Prozedur.
Auf Blatt1 einer Arbeitsmappe ist ein Button mit dem Makro. Dadurch wird aus dem
zu versendenden Arbeitsblatt 2 eine temporäre Kopie erstellt, per Lotus Notes versendet
und anschließend wieder gelöscht. Du musst nur die Pfade und Dateinamen anpassen.
Klappt prima bei mir...
Hoffentlich gibt Dir das die nötigen Anregungen :-)
Makro: versenden eines Excel-Arbeitsblattes per Lotus Notes
Annahme:
Eine Excel-Arbeitsmappe im Verzeichnis Y:\xxx enthält die Arbeitsblätter
Tabelle1 und Tabelle2. Auf der ersten Seite befindet sich ein Commandbutton,
der die Versendung des zweiten Arbeitsblattes nach einer Passwortabfrage auslöst.
Dazu wird das zweite Blatt als Sendekopie kopiert und diese Kopie
als Dateianhang per Lotus Notes versendet.
Anschließend wird die Kopie auf dem Laufwerk wieder gelöscht.
In der Lotus Notes Datenbank wird eine Sendebestätigung ausgegeben.
'1)Makrobeginn

Private Sub CommandButton1_Click()
'2)Makro für die Passwortabfrage (erster Teil)
If Application.InputBox("Bitte geben Sie ein Passwort ein!", "Passwortabfrage") = "xyz" Then
'3)Makro für den Wechsel auf das zu versendende Arbeitsblatt und das
'  Abspeichern dieses Blattes in eine neue Arbeitsmappe unter dem Namen "Test_Sendekopie"
Range("A1").Select
Sheets("Tabelle2").Select
Sheets("Tabelle2").Copy
ChDir "Y:\xxx"   Speicherort der Arbeitsmappe
ActiveWorkbook.SaveAs Filename:="Y:\xxx\Test_Sendekopie.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
'4)Makro für das Versenden der Datei "Test_Sendekopie" per Lotus Notes
Dim Maildb As Object
Dim MailDbName As String
Dim MailDoc As Object
Dim session As Object
Dim Recip(1) As Variant
Dim e As String
Dim f As String
Dim EmbedObj As Object
Dim AttachME As Object
Set session = CreateObject("Notes.NotesSession")
Set Maildb = session.CURRENTDATABASE
'On Error Resume Next
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
'(Bei mehreren Empfängern die Zahlen in den Klammern entsprechend hochzählen
'und die Zahl in der oberen Zeile "Dim Recip() as Variant entsprechend ändern)
Recip(1) = "empfänger1@xyz.de"
'Recip(2) = "empfänger2@xyz.de"
MailDoc.sendto = Recip
MailDoc.CopyTo = ""                            'Kopie an:"xxx@yyy"
MailDoc.Subject = "Versendung der Test-Datei"  '("Betreffzeile")
MailDoc.SAVEMESSAGEONSEND = True
'Hier in der Klammer den Pfad zur zu versendenden Datei eingeben
Set AttachME = MailDoc.CREATERICHTEXTITEM("Y:\xxx\Test_Sendekopie.xls")
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", "Y:\xxx\Test_Sendekopie.xls")
MailDoc.PostedDate = Now()
MailDoc.SEND 0, Recipient
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set session = Nothing
Set EmbedObj = Nothing
MsgBox "Mail wurde erfolgreich versendet !"
'5)Der Ordner "Test_Sendekopie"  wird geschlossen und gelöscht
ActiveWorkbook.Close
Kill "Y:\xxx\Test_Sendekopie.xls"
'6)Rückkehr auf das Arbeitsblatt "Tabelle1"
Sheets("Tabelle1").Select
'7)Makro_Rest des Passwortabfragecodes
Else
MsgBox "Sie haben nicht die Berechtigung, das Makro auszuführen", vbCritical, "Fehler"
End If
End Sub

Beliebteste Forumthreads (12 Monate)

Exceldatei per Lotus an variable Empfänger senden

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Exceldatei per Lotus an variable Empfänger senden

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread