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
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