Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1388to1392
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

.Recipients.add

.Recipients.add
05.11.2014 08:00:55
Florin
Moin Leute,
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

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: .Recipients.add
05.11.2014 10:42:27
Rudi
Hallo,
würde ich so machen:
  For Each rngCell In rngSrc
If rngCell.Value Like "*@*" Then
strRec = strRec & ";" & rngCell
End If
Next
.To = Mid(strRec, 2)

Gruß
Rudi

AW: .Recipients.add
06.11.2014 09:30:28
Florin
Moin Rudi,
also ich habe es jetzt hinbekommen, allerdings habe ich ein kleines Logikproblem:
Meine Schleife funktioniert ja so, dass Excel die Activecell abfragt und sich daraus die Infos für den Betreff und das Datum zieht. Am ende der Schleife springt die Activecell eine Zeile weiter.
Meine recipients.add Schleife funktioniert anders, dort frage ich einmal alle Zeilen ab und sende somit jeden Termin an alle Kontakte...
Siehst du eine Möglichkeit die recipients.add Schleife auch mit einer Activecell Variante zu lösen?
Ich habe schon die verschiedensten Sachen ausprobiert, leider funktionierte bisher alles nicht.
Vielen Dank jetzt schon einmal für die Hilfe!
'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("D2:D4")
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

Gruß
Florin

Anzeige
AW: .Recipients.add
06.11.2014 12:58:13
Florin
Moin nochmal,
kann es sein, dass .recipients.add einfach keine Variablen aktzeptiert?
LG Florin

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige