Outlook Ergänzung
13.08.2015 20:47:18
Walter
ich habe folgendes Makro gefunden, die geöffnete Datei wird
auch korrekt in Outlook reinkopiert.
Ich möchte aber vor dem .xls noch den Namen aus der Zelle
z.b. C11 + C12 als Dateinamen gesetzt haben.
Also Beispiel: die Datei heißt: Test.xls dann soll
Test WB 13.08.2015 also Test WB 13.08.2015.xls
vielleicht kann jemand helfen,
danke im Voraus.
Gruß
Walter mb
Sub Orginal_Excel_Workbook_via_Outlook_Senden()
Dim MyMessage As Object, MyOutApp As Object
Dim Qe As Integer
Dim AWS As String
'Testen ob die aktuelle Mappe schon gespeichert wurde
If ThisWorkbook.Saved = False Then
'Die letzten Änderungen wurden noch nicht gespeichert
Qe = MsgBox("Diese Mappe wurde noch nicht gespeichert, und kann nicht versandt werden!" _
_
& Chr$(13) & "Soll die Datei gespeichert werden?", vbInformation + vbYesNo, " _
Sendefehler")
If Qe = vbNo Then
'Abbruch durch Benutzer
MsgBox "Sendevorgang abgebrochen"
Exit Sub
Else
'Prüfen ob die Datei schon mal gespeichert wurde
If Right(ThisWorkbook.Name, 3) "xls" Then
'Nein > Speicherdialog aufrufen
Application.Dialogs(xlDialogSaveAs).Show
Else
'Speichern
ThisWorkbook.Save
End If
End If
End If
'Aktive Arbeitsmappe wird als mail gesendet
'Übergabe des Mappennames an die Variable
AWS = ThisWorkbook.FullName
'Outlook Object erstellen
Set MyOutApp = CreateObject("Outlook.Application")
'Outlook Nachricht erstellen
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
'Empfänger
' .To = "irgendwer@provider"
.To = ""
'Betreff
'.Subject = "Test 13.08.2015 für Daners" & Date & Time
.Subject = "Rechnung: " '& ActiveSheet.Name
.Attachments.Add AWS
'Hier wird ein normaler Text erstellt
.Body = "Hier den Text einsetzen..."
'Dies kann zu ProblemMail für normalen Textempfang"
'Hier wird eine HTML Mail erstellten führen, wenn der Empfänger
'nur TEXT Dateien empfangen darf.
'.HTMLBody = "Das ist ein Test." & vbCrLf & "Bitte ignorieren."
'Hier wird die Mail nochmals angezeigt
.Display
'Hier wird die Mail gleich in den Postausgang gelegt und gesendet
'.Send
End With
'Outlook schliessen
MyOutApp.Quit
'Variablen leeren
Set MyOutApp = Nothing
Set MyMessage = Nothing
End Sub