Mail-Ausdruck über Makro - Gesamtseitenzahl falsch

[Niniju-san]

Hallo liebe Office-Experten, 

Ich fange mal mit dem Klassiker an, dass ich natürlich schon gesucht habe, jedoch keine Lösung gefunden habe. Ich hoffe, dass mir jetzt nicht der erste direkt da was anderes serviert.

ich stehe vor folgendem Problem:

Ich habe mir für Outlook ein Makro aus den Weiten des Internets geholt, mit dessen Hilfe ich gesendete E-Mails mit einer kurzen Abfrage Drucken kann. Klappt von Seiten des Makros auch wunderbar. Nur der Ausdruck enthält dann bei der Seitenangabe in der Fußzeile "1 von 0", "2 von 0" u.s.w. Sprich der Wert für Gesamtzahl der Seiten wird nicht "erzeugt" oder "mitgegeben". Über den manuellen Weg ist die Angabe dagegen korekt.
Gibt es da irgendwo eine Einstellung die angepasst werden muss oder müsste da noch etwas ins Makro? Outlook und VBA scheint ja im Gegensatz zu Word und Excel auch nicht ganz so intensiv behandelt zu werden.

Das Makro lautet übrigens:

Code:

Public WithEvents myOlItemSend As Outlook.Items

Public Sub Application_startup()

Set myOlItemSend = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail).Items

End Sub

Private Sub myOlItemSend_ItemAdd(ByVal Item As Object)

If MsgBox("Soll die E-Mail gedruckt werden?", vbYesNo, "Drucken?") = vbYes Then
    Item.PrintOut
End If

End Sub

[Niniju-san]

OK, nachdem ich mir nunmal auch noch ein paar Gedanken zum eigentlich Prozess gemacht habe, habe ich mich für eine Art "Work-around" entschieden, der zumindest funktioniert und auch nicht mehr Klicks verursacht. mit Mail.Display öffne ich einfach die gesendete Mail und entscheide dann so, ob sie gedruckt werden muss/soll. Gleichzeitig speichert er mir die Mail nun noch.

Code:

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()

Dim Ns As Outlook.NameSpace
Dim myRecipient As Outlook.Recipient

Set Ns = Application.GetNamespace("MAPI")
Set Items = Ns.GetDefaultFolder(olFolderSentMail).Items

End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)

If TypeOf Item Is Outlook.MailItem Then
    PrintNewItem Item
End If

End Sub

Private Sub PrintNewItem(Mail As Outlook.MailItem)

Dim Speicherpfad As String
Dim Name As String
Dim Dateiname As String
Dim Dat As New DataObject

With Mail
    Name = Replace(Mail.Subject, "/", "_")
    Name = Replace(Name, "!", "")
    Name = Replace(Name, ".", "_")
    Name = Replace(Name, "\", "_")
    Name = Replace(Name, ":", "_")
    Name = Replace(Name, "(", "")
    Name = Replace(Name, ")", "")
    Name = Replace(Name, """", "")
End With

Speicherpfad = " *Mein Pfad* "
Dateiname = Format(Mail.ReceivedTime, "YYYY.MM.DD") & " " & Name & ".msg"

Mail.SaveAs (Speicherpfad & Dateiname)
Mail.Display

End Sub

Da ich mit Outlook noch nicht ganz so VBA erfahren bin, bin ich gern offen für Anmerkungen, falls das jetzt hier nicht so richtig sauber sein sollte.