Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

.Recipients.add

Betrifft: .Recipients.add von: Florin
Geschrieben am: 05.11.2014 08:00:55

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

  

Betrifft: AW: .Recipients.add von: Rudi Maintaire
Geschrieben am: 05.11.2014 10:42:27

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


  

Betrifft: AW: .Recipients.add von: Florin
Geschrieben am: 06.11.2014 09:30:28

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


  

Betrifft: AW: .Recipients.add von: Florin
Geschrieben am: 06.11.2014 12:58:13

Moin nochmal,

kann es sein, dass .recipients.add einfach keine Variablen aktzeptiert?

LG Florin