VBA Outlook 2010 Fehler (xlDialogSaveAs).Show

Option Explicit
Public IEApp, IEDocument, fso As Object
Public i, WochentaG, MultIp As Byte
Public GesDat As Date
Public pfad11, StrTyp, Dateiname, Dateiname_neu, Zeit, strPath, file As Variant
Public Mail As Outlook.mailitem
Function SZeit() As Date
pfad11 = "C:\Temp\"
StrTyp = "star.xlsm"
Dateiname = Dir(pfad11 & StrTyp)
Dateiname_neu = Dateiname
SZeit = FileDateTime(pfad11 & Dateiname)
End Function
Function eXeX() As Object
Set eXeX = CreateObject("Excel.Application")
With eXeX
.Visible = True
.EnableEvents = False
End With
End Function
Function MonAt2() As Variant
MonAt2 = Format(Date, "MMMM" & "_" & "YYYY")
End Function
Function JaHr2() As Variant
JaHr2 = Format(Date, "YYYY")
End Function
Public Sub SaveDat(Mail As Outlook.mailitem)
If Mail.Attachments.Count > 0 And Mail.ReceivedTime > SZeit Then
For i = 1 To Mail.Attachments.Count
If (Mid(Mail.Attachments.Item(i).FileName, 1, 8) = "xxxxxxxx") Then
Mail.Attachments.Item(i).SaveAsFile "C:\Temp\Test\" & Mail.Attachments.Item(i). _
FileName
pfad11 = "C:\Temp\Test\"
StrTyp = Mail.Attachments.Item(i).FileName '"*xxx*.xls*"
Dateiname = Dir(pfad11 & StrTyp)
Dateiname_neu = Dateiname
Zeit = FileDateTime(pfad11 & Dateiname)
Do While Dateiname  ""
If Zeit .Sheets.Count.Activate 'FEHLER
.ActiveWorkbook.PrintOut Copies:=1, Collate:=True
.Application.Dialogs(xlDialogSaveAs).Show "d:\xx\" _
& JaHr2 & "\" & MonAt2 & "\" & Dateiname_neu 'FEHLER
.Application.Quit
End With
End If
Next i
End If
End Sub