Übergabe einzelner in einer Pivottabelle angefilterten Werte (Namen) als Email nach Outlook

  • Excel

    Übergabe einzelner in einer Pivottabelle angefilterten Werte (Namen) als Email nach Outlook

    Hallo liebe User von VB-Paradise,

    ich habe folgendes Problem und hoffe, dass Ihr mir dabei weiter helfen könnt.

    In einer Pivot-Tabelle (Basis OLE) filtere ich einzelne Namen an und übergebe anschließend auf Basis dieser Namen einen bestimmten Bereich als E-Mail an Outlook. An sich funktioniert das wunderbar. Jetzt habe ich allerdings festgestellt, dass nicht alle dargestellten Namen in der Pivot-Tabelle "abgearbeitet" werden. Beispiel: Ich habe 8 Namen - also eigentlich auch 8 E-Mails. Erzeugt werden jedoch nur 5 Mails. Ich bin fast am verzweifeln, da ich hier den Fehler nicht finde, warum nicht alle 8 Namen als E-Mail erzeugt werden. Ich hoffe, ich habe mich klar ausgedrückt ^^

    Die "Basis Pivot-Tabelle" habe ich mit angehängt.

    Hier mein VBA Code, die Funktion um die E-Mail zu generieren habe ich aus Platzgründen weggelassen.

    Sub Mail_Senden()
    Dim objNachricht As Object
    Dim objmail As Object
    Dim mail_name As String
    Dim mail_vorname As String
    Dim LZ As Long 'letzte Zeile
    Dim rng As Range
    Dim itm As Variant

    Set objmail = CreateObject("Outlook.Application")
    Set objNachricht = objmail.createitem(0)
    Set Pivot_Table = ActiveSheet.PivotTables("PivotTable2").PivotFields

    Application.ScreenUpdating = False

    Pivot_Table( _ "[4 - Persons].[Employee Name].[Employee Name1]").VisibleItemsList = Array( _
    "[4 - Persons].[Employee Name].[Employee Name1].[GROUPMEMBER.[Employee_NameXl_Grp_1]].[4 - Persons]].[Employee Name]].[All]]]", _
    "[4 - Persons].[Employee Name].[Employee Name1].[GROUPMEMBER.[Employee_NameXl_Grp_2]].[4 - Persons]].[Employee Name]].[All]]]", _
    "[4 - Persons].[Employee Name].[Employee Name1].[GROUPMEMBER.[Employee_NameXl_Grp_3]].[4 - Persons]].[Employee Name]].[All]]]")

    For Each itm In Pivot_Table("[4 - Persons].[Employee Name].[Employee Name]").PivotItems

    Pivot_Table("[4 - Persons].[Employee Name].[Employee Name1]").VisibleItemsList = Array("")
    Pivot_Table("[4 - Persons].[Employee Name].[Employee Name]").VisibleItemsList = Array(itm)

    LZ = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

    Set rng = Range("A10:J" & LZ)
    rng.Copy

    PositionEnd = Len(itm)
    positionStart = InStrRev(itm, "&[", PositionEnd) + 2

    mail_name = Mid(itm, positionStart, PositionEnd - positionStart)
    mail_vorname = InStr(mail_name, " ")
    mail_vorname = Left(mail_name, mail_vorname - 1)

    If Range("A" & LZ) <> "Gesamtergebnis" Then GoTo Naechster

    '*********************

    With objmail.createitem(0)
    .getInspector .To = mail_name
    .HTMLBody = "<font size=""2"" face=""Arial"" >" & _ "Hallo " & mail_vorname & "," & "<br>" & "<br>" & _ "xxx" & "<b>" & _
    "<hr noshade size=1 width=100%>" & _
    RangetoHTML(rng) & .HTMLBody
    .Display
    End With

    Naechster:

    Next itm

    Set objNachricht = Nothing
    Set objmail = Nothing
    Set rng = Nothing

    Pivot_Table( _
    "[4 - Persons].[Employee Name].[Employee Name1]").VisibleItemsList = Array( _
    "[4 - Persons].[Employee Name].[Employee Name1].[GROUPMEMBER.[Employee_NameXl_Grp_1]].[4 - Persons]].[Employee Name]].[All]]]", _
    "[4 - Persons].[Employee Name].[Employee Name1].[GROUPMEMBER.[Employee_NameXl_Grp_2]].[4 - Persons]].[Employee Name]].[All]]]", _
    "[4 - Persons].[Employee Name].[Employee Name1].[GROUPMEMBER.[Employee_NameXl_Grp_3]].[4 - Persons]].[Employee Name]].[All]]]")

    Application.ScreenUpdating = True

    End Sub

    Vielen Dank für Eure Hilfe

    Jörg
    Bilder
    • Beispiel.PNG

      26 kB, 1.101×556, 45 mal angesehen