.Recipients.add
05.11.2014 08:00:55
Florin
ich habe schon einen Beitrag zu diesem Thema, bekomme es allerdings nicht mehr hin, dort noch ein Kommentar zu posten... Also, ich habe einen neuen Ansatz zum Thema "mehrere Empfänger mit .recipients.add hinzufügen":
'Vor der Programmierung "Verweise" um die Office Libary erweitern!
Public Sub terminegenerieren()
Dim TerminText As String
Dim OutApp As Object, apptOutApp As Object
Dim Spalte, SpalteN As Variant
Dim objRecipient As Outlook.Recipient
Dim b, x As Integer
Dim myitem As Object
Dim rngSrc As Range
Dim rngCell As Range
Range("B2").Select
'Wählt Spalte B, Zeile 2 aus
Do Until ActiveCell.Value = "Stop"
'Do Schleif, bis die ausgewählte Zelle "Stop" ist
Set OutApp = CreateObject("Outlook.Application")
'Legt ein Outlook-Objekt an
Set rngSrc = Range("F2:BF4")
Set apptOutApp = OutApp.CreateItem(1)
'Legt ein "Appointmentitem"-Objekt an
With apptOutApp
.BusyStatus = olFree
'Termin-Status
.MeetingStatus = 1
.Start = Format(ActiveCell.Value, "dd.mm.yyyy") & " 08:00"
'Startzeitpunkt des Termins (Ausgewählte Zelle gibt das Datum an)
.Subject = ActiveCell.Offset(0, 1)
'Betreff des Termins (Ausgewählte Zelle + 1)
For Each rngCell In rngSrc
If rngCell.Value Like "*@*" Then ' minimaler Test ob da auch eine Email-Adresse steht
.Recipients.Add rngCell.Value
End If
Next
'Gibt weitere Empfänger/Teilnehmer des Termins an
.Body = "Hier steht ein Text."
'Inhalt des Termins
.Location = "Büro"
'Ort des Termins
.Duration = "60"
'Dauer des Termins
.ReminderMinutesBeforeStart = 10
'Erringerung vor dem Termin
.ReminderSet = True
'Errinerung aktiviert
.ResponseRequested = True
'Antwort auf den Termin benötigt
.Send
'Sendet den Termin an den Empfänger
.Save
'Speichert die EntryID des Termins
ActiveCell.Offset(0, 4) = .EntryID
'Schreibt die EntryID in die gewählte Zelle + 4
End With
ActiveCell.Offset(1, 0).Select
'Ausgewählte Zelle springt eine Zeile weiter
Set apptOutApp = Nothing
Set OutApp = Nothing
'Variablen werden geleert
Loop
'Do Schleif, bis die ausgewählte Zelle "Stop" ist
MsgBox "Termin an Outlook übertragen!"
'Meldung für den Excel-User
End Sub
Ich bekomme keine Fehlermeldung wenn ich dieses Makro ausführe. Allerdings werden auch keine E-Mails mit den Terminen verandt.
Vielleicht sieht ja einer von euch den Fehler... :)
LG
Florin