Hallo liebe Community,

ich habe folgendes Problem:

Ich möchte eine Datei also pdf speichern und versenden lassen.

Der Verteiler soll über zwei Zellen festgelegt werden "Fester Verteiler" Zelle (A2), "Variabler Verteiler " Zelle (A4), in einem bestimmten Tabellenblatt "Verteiler".

Ich bekomme es nicht hin dass An alle in den Zellen eingetragenen eMailadressen wirklich gesendet wird.

Immer nur an die die an erster Stelle steht.

' **************************************************************
'  Modul:  mdlLotusNotes  Typ = Allgemeines Modul
' **************************************************************
Option Explicit
 
Sub lotus()
ChDir "C:\Users\U17916\Desktop"
Worksheets("Unfallanzeige").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\U17916\Desktop\Unfallanzeige.pdf"

 ' Hier sind VBA 6 Funktionalitäten (Split Replace)
 ' also in dieser Version ab E 2000
 ' Peter Haserodt 2004 - zusammengetragen aus dem Net '
 ' und zusammengeschustert ;-)
 ' Für jeden auf eigene Gefahr und eigenem Verständis
 ' ############################################################
 ' Die Variablen für Empfänger und Anhang sind richtig zu belegen
 ' ############################################################
 Dim sText As String, sEmpfang As String, sBetrifft As String
 Dim session As Object, db As Object, doc As Object, rtobject As Object
 Dim rtitem As Object, sKopie As String
 Dim AttachMe As Object, DerAnhang As Object
 Dim user As String, server As String
 Dim mailfile As String, sBlindKopie As String
 Dim vAn As Variant, vCopy As Variant
 Dim vBlind As Variant, sAnhang As String
 On Error GoTo Fehler
 sText = "Dies ist eine automatisch generierte eMail. " & vbCrLf & "Bei Fragen bitte an den Versender wenden." ' Testtext
 sText = Replace(sText, vbCrLf, Chr(10)) ' Zeilenumbrüche ändern
 sEmpfang = Worksheets("Verteiler").Range("A2:A50")  ' Einträge durch " ; " getrennt
 sBetrifft = "Unfallanzeige" ' die Betreffzeile
 sKopie = "Email1 ; Email2 " ' Einträge durch " ; " getrennt
 sBlindKopie = "Email1 ; Email2 " ' Einträge durch " ; " getrennt
 vAn = Split(sEmpfang, " ; ") ' Empfänger Array
 sAnhang = "C:\Users\U17916\Desktop\Unfallanzeige.pdf" ' Muss natürlich richtig gesetzt werden
 If Len(sKopie) > 0 Then vCopy = Split(sKopie, " ; ") 'cc Array
 If Len(sBlindKopie) > 0 Then vBlind = Split(sBlindKopie, " ; ")  'bcc Array
 Set session = CreateObject("notes.notessession") ' Notes muss gestartet sein
 user = session.UserName
 server = session.GetEnvironmentString("MailServer", True)
 mailfile = session.GetEnvironmentString("MailFile", True)
 Set db = session.getdatabase(server, mailfile)
 Set doc = db.createdocument()
 doc.Form = "Memo"
 doc.SendTo = vAn  ' an array
 If Len(sKopie) > 0 Then doc.copyto = vCopy 'cc Array
 If Len(sBlindKopie) > 0 Then doc.blindcopyto = vBlind 'bcc Array
 doc.Subject = sBetrifft ' die Betreffzeile
 Set rtitem = doc.CREATERICHTEXTITEM("body")
 Call rtitem.APPENDTEXT(sText)
 doc.SAVEMESSAGEONSEND = True
 doc.PostedDate = Now
 ' *******************************************

 If sAnhang <> "" Then
  Set AttachMe = doc.CREATERICHTEXTITEM("Attachment")
  Set DerAnhang = AttachMe.EMBEDOBJECT(1454, "", sAnhang, "Attachment")
 End If
 '*******************************
 Call doc.Send(False)
Aufraeumen:
 On Error Resume Next
 Set rtitem = Nothing
 Set AttachMe = Nothing
 Set DerAnhang = Nothing
 Set db = Nothing
 Set doc = Nothing
 Set session = Nothing
 Exit Sub
Fehler:
 Resume Aufraeumen
End Sub

Ich habe unter sEmpfang einen Range angegeben, funktioniert jedoch auch nicht.
Könnt ihr mir evtl. weiterhelfen?

Desweiteren bekomme ich es nicht hin, dass die Datei unabhängig vom Username gesepcihert wird.
Also es sollte auf jeden Rechner verwendbar sein und immer auf dem Desktop gespeichert weerden.
Habt ihr dazu vll auch eine Lösung?

Dake euch im Voraus.

Mit freundlichen Grüßen
Chris