E-Mail-Anhang per Makro individuell ändern

Marcus · 2017-04-05T17:08:34+00:00

Hallo zusammen, ich bitte um eure Hilfe. Ich habe eine xls. Datei die über ein Makro per Mail durch das Klicken eines Steuerelements verschickt werden soll. Der Dateiname im Anhang soll durch den Klick auf den Button über eine Abfrage (Msgbox o.ä.) individuell geändert werden. Bsp: Dateiname roh: Bauklötze Dateiname im Anhang: Bauklötze_Stuttgart Der Zusatz "Stuttgart" soll über diese Box an den Dateinamen mit "_" dran gehangen werden. Bei Eintippen "Berlin" dann entsprechend Bauklötze_Berlin. Diese Datei soll dann automatisch in eine Mail angehangen werden. Diese Mail soll dann die Empfänger und den Text automatisch füllen. Geht sowas? Viele Grüße P.S. Mein E-Mail Makro sieht bisher so aus: Sub Excel_Workbook_via_Outlook_Senden() Dim Nachricht As Object, OutApp As Object Set OutApp = CreateObject("Outlook.Application") Dim AWS As String AWS = ThisWorkbook.FullName Set Nachricht = OutApp.CreateItem(0) With Nachricht .To = "max.mustermann@gmail.com" .Subject = "Datenbank vom " & Date .attachments.Add AWS .Body = "Hallo zusammen," & vbCrLf & "" & vbCrLf & "anbei erhalten Sie die aktuelle Datenbank _ _ für Ihre weitere Verwendung." & vbCrLf & "" & vbCrLf & "Mit freundlichen Grüßen" .Display End With Set OutApp = Nothing Set Nachricht = Nothing End Sub

Hallo!
Habe Deinen Code auch gleich etwas aufgeräumt, inkl. Änderung des Dateinamens des Attachements per User-Eingabe: beim Starten dieses Makros wird der Benutzer zur Eingabe eines Textes aufgefordert, der dann an den Dateinamen des Attachements angefügt wird. Ein Abbruch der Eingabe-Aufforderung bricht das gesamte Makro (Mailversand) ab...

Sub MappeViaOutlookSenden()
Const AN$ = "max.mustermann@gmail.com"
Const BETREFF$ = "Datenbank vom "
Const ANREDE$ = "Hallo zusammen"
Const TEXT$ = "Anbei erhalten Sie die aktuelle Datenbank für Ihre weitere Verwendung."
Const GRUSS$ = "Mit freundlichen Grüßen"
Const TYP$ = ".xlsx"
Const SEP$ = "_"
Dim WbQ As Workbook: Set WbQ = ThisWorkbook
Dim Ol As Object, Eml As Object
Dim Suf$, Pfad$, Anhang$
Pfad = WbQ.Path & "\"
Suf = Application.InputBox("Dateinamen-Zusatz eingeben:", _
"Dateiname Email-Anhang", , , , , , 2)
If Suf = "" Or Suf = False Then Exit Sub
Anhang = Pfad & Left(WbQ.Name, InStr(1, WbQ.Name, ".") - 1) & SEP & Suf & TYP
WbQ.SaveCopyAs Anhang
Set Ol = CreateObject("Outlook.Application")
Set Eml = Ol.CreateItem(0)
With Eml
.To = AN
.Subject = BETREFF & Date
.Attachments.Add Anhang
.Body = ANREDE & vbLf & vbLf & TEXT & vbLf & vbLf & GRUSS
.Display
End With
Kill Anhang
Set Ol = Nothing
Set Eml = Nothing
End Sub

Anpassen müsstest Du ggf. den Dateityp, das ist bei mir aktuell ".xlsx", Du hast von .xls geschrieben, also bei Bedarf anpassen.
Grundsätzlich: Alle Variablen-Deklarationen IMMER in den Prozedur-Kopf, nicht zwischendrin im (fertigen) Code; das ist für die Wartung etc. nicht geeignet. Ich habe Dir auch einige Werte als Konstanten im Prozedurkopf angelegt, das macht das Makro etwas leichter handhabbar in der Wartung bzw. kannst Du es so schneller auf andere Anwendungsfälle anpassen.
Die grds. Vorgehensweise ist hier so: Zuerst speicherst Du eine Kopie Deiner Arbeitsmappe (am gleichen Ort) mit dem neuen Dateinamen, fügst diese Kopie als Attachement hinzu, und löschst danach die Dateikopie wieder (siehe Code).
Passt?
LG
Michael

Hallo!
Die grds. Frage ist: Mit welcher Excel-Version arbeitest Du? Angegeben hast Du XL 14/2010, aber in Deinem Beitrag schreibst Du von einer ".xls"-Datei, was gilt?
.xls ist ein Dateiformat VOR Office 2007, seit Office 2007 gibt es die Dateiendungen .xlsx und .xlsm (und zugehörige Vorlagen-Dateitypen), wobei ersteres eine Arbeitsmappe OHNE Makros und Zweiteres eine Arbeitsmappe MIT Makros darstellt.
D.h.: Wenn in Deiner Original-Mappe das o.a. Makro enthalten ist, dann solltest Du diese Mappe als ".xlsm" speichern. Allerdings sollte dann auch die Kopie, die per Outlook versendet wird, den gleichen Dateityp haben, also

Const TYP$ = ".xlsm"

...denn sonst verschickst Du eine Datei, die nicht geöffnet werden kann, weil der Dateityp falsch ist.
Beachte, dass in diesem Fall dann auch die versendete Datei die Makros des Originals enthält. Wenn Du das nicht willst, geht es nicht so einfach über eine Kopie der Arbeitsmappe, sondern dann müsste mit Tabellenblättern des Originals eine gänzlich neue Mappe erzeugt werden, und diese dann versendet werden.
Hier der überarbeitete Code bzgl. Laufzeitfehler:

Sub MappeViaOutlookSenden()
Const AN$ = "max.mustermann@gmail.com"
Const BETREFF$ = "Datenbank vom "
Const ANREDE$ = "Hallo zusammen"
Const TEXT$ = "Anbei erhalten Sie die aktuelle Datenbank für Ihre weitere Verwendung."
Const GRUSS$ = "Mit freundlichen Grüßen"
Const TYP$ = ".xlsm"
Const SEP$ = "_"
Dim WbQ As Workbook: Set WbQ = ThisWorkbook
Dim Ol As Object, Eml As Object
Dim Suf$, Pfad$, Anhang$
Pfad = WbQ.Path & "\"
Suf = Application.InputBox("Dateinamen-Zusatz eingeben:", _
"Dateiname Email-Anhang", , , , , , 2 + 4)
Select Case Suf
Case Is = vbNullString: Exit Sub
Case Is = False: Exit Sub
End Select
Anhang = Pfad & Left(WbQ.Name, InStr(1, WbQ.Name, ".") - 1) & SEP & Suf & TYP
WbQ.SaveCopyAs Anhang
Set Ol = CreateObject("Outlook.Application")
Set Eml = Ol.CreateItem(0)
With Eml
.To = AN
.Subject = BETREFF & Date
.Attachments.Add Anhang
.Body = ANREDE & vbLf & vbLf & TEXT & vbLf & vbLf & GRUSS
.Display
End With
Kill Anhang
Set Ol = Nothing
Set Eml = Nothing
End Sub

Lg
Michael

E-Mail-Anhang per Makro individuell ändern

Forumthread: E-Mail-Anhang per Makro individuell ändern

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial