Makro funktioniert nur zum Teil
02.03.2008 14:21:16
Mister
mit folgendem Makro wird eine bestimmte Excel-Tabelle in einer Datei gespeichert und zusätzlich als Anlage in einer Email versendet. Das Problem liegt darin, dass die Datei nicht angehängt wird:
Sub EndMonth()
If Day(Now) = Sheets("Statistik").Range("F52") Then
Call Excel_Sheet_via_Outlook_Senden
Sheets("Bestand").Range("A1") = "X"
Sheets("Startseite").Select
End If
End Sub
Sub Excel_Sheet_via_Outlook_Senden()
Dim Text As String
Dim Nachricht As Object, OutApp As Object
Dim SavePath As String
Dim AWS As String
On Error Resume Next
Application.DisplayAlerts = False
Statistik
If Sheets("Bestand").Range("A1") = "X" Then Exit Sub
Text = "Sehr geehrte Kollegen, " & vbNewLine
Text = Text & vbNewLine
Set OutApp = CreateObject("Outlook.Application")
'Kopiert aktuelles Sheet in eine neue Mappe
'welche nur diese Tabelle enthält
Sheets("Statistik").Activate
ActiveSheet.Unprotect
ActiveSheet.Copy
ActiveSheet.Shapes("CommandButton1").Select
Selection.Cut
'Speichert die Datei unter dem Tabellennamen und dem Namen in A1
SavePath = "X:\A-West\Statistik\" & "Monatsstatistik - " _
& Format(Date, "mmmm yyyy") & ".xls"
ActiveWorkbook.SaveAs Filename:=SavePath
'Aktive Arbeitsmappe wird als mail gesendet
AWS = ActiveWorkbook.FullName
'InitializeOutlook = True
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = "StatistikEmpf"
.Subject = "Statistik " & Format(Date, "mmmm yyyy")
.Attachments.Add AWS
'Hier wird eine normale Text Mail erstellt
.body = Text
'Hier wird die HTML Mail erstellt
'.HTMLBody =
'Hier wird die Mail nochmals angezeigt
.Display
'Hier wird die Mail gleich in den Postausgang gelegt
.Send
'Hier könnte die Datei wieder gelöscht werden
'Kill AWS
End With
Set OutApp = Nothing
Set Nachricht = Nothing
ActiveWindow.Close
Application.DisplayAlerts = True
End Sub
In F52 steht die Anzahl der Tagen im aktuellen Monat. Das Makro wird am letzten Tag eines jeden Monats ausgeführt. Warum funktioniert es nicht?
Gruß
Martin