AW: Exceldateien per LN an variable Empfänger senden
03.11.2009 09:46:47
Armin
Hallo Wolfgang,
so müsste es gehen. Man kann natürlich auch alle Adressen auf einmal lesen und in einem Pool zwischenspeichern. Pfade und Namen müssen noch angepasst werden.
Sub Sende_per_LotusNotes()
Dim Maildb As Object
Dim MailDbName As String
Dim MailDoc As Object
Dim session As Object
'Bei nur einem Empfänger in der folgenden Zeile (1), sonst Anzahl Empfänger
Dim RC As String
Dim Recip(2) As Variant
Dim e As String
Dim AdrId As Integer
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 bei "Dim Recip() as Variant entsprechend ändern
AdrId = 1
RC = ADR_daten(ADR_ID)
Do While RC ""
MailDoc.sendto = RC
MailDoc.CopyTo = "" 'Kopie an:"xyz" hier eintragen
MailDoc.Subject = "Test" 'Betreffzeile: "xyz" hier eintragen
MailDoc.SAVEMESSAGEONSEND = True
'Hier in der Klammer den Pfad zur zu versendenden Datei eingeben
Set AttachME = MailDoc.CREATERICHTEXTITEM("C:\Dokumente und Einstellungen\User1\Desktop\ _
Test.xls ")
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", "C:\Dokumente und Einstellungen\User1\Desktop\ _
Test.xls ")
'Um weitere Dateianhänge mitzusenden, in den nächsten Zeilen den Pfad zu dieser Datei _
eingeben.' _
Ansonsten können die nächsten zwei Zeilen gelöscht bzw. durch (') deaktiviert werden
Set AttachME = MailDoc.CREATERICHTEXTITEM("C:\Dokumente und Einstellungen\User1\Desktop\ _
Test1.xls ")
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", "C:\Dokumente und Einstellungen\User1\Desktop\ _
Test1.xls ")
MailDoc.PostedDate = Now()
MailDoc.SEND 0, Recipient
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set session = Nothing
Set EmbedObj = Nothing
ADR_ID = ADR_ID + 1
RC = ADR_daten(ADR_ID)
' ? MsgBox "Mail versandt!"
Loop
End Sub
Function ADR_daten(ADR_ID As Integer)
Dim Pfad As String
Dim FName As String
Dim WS As Worksheet
FName = "MeineAdressen.xls"
Application.ScreenUpdating = False
Pfad = ActiveWorkbook.Path & "\Adressen\"
If Dir(Pfad & FName) "" Then
Application.DisplayAlerts = False
Workbooks.Open Filename:=Pfad & FName, ReadOnly:=True
ADR_daten = Worksheet("EMail").Celles(ADR_ID, 1).Value
Workbooks(f).Close savechanges:=False
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Function
Gruß Armin