Datei per Mail unter einen neuen Namen verschicken
04.02.2008 08:49:00
Patric
ich habe folgendes Script welches auch super funktioniert:
Private Sub CommandButton2_Click()
If ActiveSheet.ProtectContents = True Then Exit Sub
Dim MyMessage As Object, MyOutApp As Object
Dim Qe As Integer
Dim AWS As String
'Speichert eine Kopie des Arbeitsblattes
AWS = ThisWorkbook.FullName
AWS = Environ("Temp") & "/Spesenabrechnung_" & Range("B3") & "_" & Format(Now, "YYYYMMDD") _
& "_" & Format(Now, "hhmmss") & ".xls"
ThisWorkbook.SaveCopyAs AWS
'Outlook Object erstellen
Set MyOutApp = CreateObject("Outlook.Application")
'Outlook Nachricht erstellen
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
'Empfänger
.To = "spesen@spesen.ch"
'Betreff
.Subject = "Spesenabrechnung " & Date & Time
.Attachments.Add AWS
'Hier wird ein normaler Text erstellt
'.Body = "Mail für normalen Textempfang"
.Display
'Hier wird die Mail gleich in den Postausgang gelegt und gesendet
'.Send
End With
'Variablen leeren
Set MyOutApp = Nothing
Set MyMessage = Nothing
'Drucken des Aktiven Arbeitblattes auf den Standart Drucker
ActiveSheet.PrintOut Copies:=1
'Hier wird die gespeicherte Kopie wieder gelöscht
Kill AWS
End Sub
kann mir einer sagen wie ich die AWS Funktion ändere, dass das xls so gespeichert wird:
[Original_Dateiname]_bearbeitet.xls
einfacher gesagt, beim Namen des geöffneten Files etwas anhängen.
Danke Für euer Hilfe
Patric