Gestern bekam ich eine Anfrage, ob man eine E-Mail aus Excel versenden kann in der das Dokument als Anhang eingefügt ist.
Zu dieser Anforderung kann man folgenden Code verwenden:
Sub Mailversand() Dim Nachricht As Object, OutlookApplication As Object Set OutlookApplication = CreateObject("Outlook.Application") Dim Anhang As String Anhang = ThisWorkbook.FullName Set Nachricht = OutlookApplication.CreateItem(0) With Nachricht .To = "mailadresse@domain.tld" .Subject = "Betreff " .attachments.Add Anhang .Body = "Mailtext" & vbCrLf & vbCrLf .Display '.Mail.Send End With Set OutlookApplication = Nothing Set Nachricht = Nothing End Sub
Wenn man das Apostroph vor dem Befehl „.Mail.Send“ entfernt, wird die Mail direkt versandt.
Hallo und vielen Dank. Mögen potentielle Auftraggeber auf diesem Wege auf dich aufmerksam werden. Verdient hast du’s und die dann hoffentlich auch.
Hallo
Ich habe einen Befehlt im Word eingegeben, leider versendet es die E-Mail automatisch, ich würde diese jedoch davor noch gerne bearbeiten z.b. andere Attachements einfügen. Ich weiss nich wo der Fehler ist 🙁
____________________________________
Sub CommandButton1_Click()
‚Working in Excel 2000-2013
‚This example send the last saved version of the Activeworkbook
‚For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object
Dim toadresse As Variant
Dim ccadresse As Variant
Dim bccadresse As Variant
Dim ssubject As Variant
Dim sbody As Variant
toadresse = „name.vorname@firma.net“
ccadresse = „name.vorname@firma.net“
ssubject = „Austrittsformular“
sbody = „Im Anhang sende ich das Austrittsformular;“
Set OutApp = CreateObject(„Outlook.Application“)
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.to = toadresse
.CC = ccadresse
.BCC = bccadresse
.Subject = ssubject
.Body = sbody
.Attachments.Add ActiveDocument.FullName
‚You can add other files also like this
‚.Attachments.Add („C:\test.txt“)
.Send ‚or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Hallo Luli,
einfach die folgende Zeile ersetzen:
alt – .Send ‚or use .Display
neu – .Display ‚or use .Send
Liebe Grüße
Daniel
Herr Lensing
Danke das Sie ihr Fachwissen zur Verfügung Stellen. Ich bin ein totaler Anfänger was VBA beinhaltet.
Ich bin Lehrer und darf dauernd Bewertungen per Mail versenden an immer die gleichen Personen.
Mit dem Code weis ich nicht umzugehen und daher funktioniert der bei mir nicht.
Frage: Haben Sie Interesse mir zu helfen per Team Viewer? LG Andreas
Hallo und guten Tag,
ich möchte eine Mail an immer denselben Empfänger verschicken. Die attachements sind jedoch täglich Andere. Die Dateien können nur über folgende Suchbefehle zugeordnet werden: heute erstellt oder hat endweder endung1 oder endung2. Es handelt sich immer um min. 2 Dateien deren Namen in Abhängigkeit zur Laufzeit generiert werden. Der Name wird nicht von mir, sondern von einem Fremdprogramm generiert. Ich hoffe du kannst mir helfen.
Gruß
Hallo,
vielen Dank für deinen Kommentar.
Es handelt sich bei deiner Anfrage um ein anderes Start- sowie Zielszenario.
Gern helfe ich dir bei deiner Aufgabenstellung.
Liebe Grüße
Daniel
Hallo Daniel
Ich habe Deinen Code gefunden und versucht in eine Excel Anwendung einzubauen, ein merkwürdiges Phänomen verhindert aber, dass meine Anforderungen erfüllt werden.
Die versendete Datei entspricht nicht dem letzten Stand von derjenigen die ich auf dem Bildschirm habe, es fehlen diverse Eingaben?
Gibt es dazu eine Erklärung, Lösung ?
Hallo Daniel,
sorry für die Verzögerung.
Vielleicht erst einmal eine doofe Frage:
Vor der Nutzung des Makros hast du die Datei mit deinen fehlenden Eingaben gespeichert?
Die Speicherung übernimmt das Skript aktuell nicht.
Ausserdem wäre es interessant, welche Office-Version du im Einsatz hast.
Liebe Grüße
Daniel
Hallo,
ich habe den Code ausprobiert und möchte meine Standard Signatur automatisch einfügen.
Es funktioniert leider nicht so mit dem GetInspector.Display
Für einen Tip wäre ich dankbar.
‚Code
‚try mail mail send auskommentiert für ansicht vor dem Senden
Dim Nachricht As Object, OutlookApplication As Object
Set OutlookApplication = CreateObject(„Outlook.Application“)
Dim Anhang As String
Anhang = ThisWorkbook.FullName
Set Nachricht = OutlookApplication.CreateItem(0)
With Nachricht
.GetInspector.Display
.To = „kerstin@test.de“
.Subject = „TEst“
‚.Attachments.Add Anhang
.HTMLBody = „Sehr geehrte Damen und Herren,im Anhang erhalten Sie die Liste.“
.Attachments.Add („my.zip“)
‚Cursor ans Ende der EMail setzen
VBA.SendKeys „^{END}“, True
‚Name der gespeicherten Signatur – bitte anpassen
strSignatur = „KV“
‚Einfügen einer bestimmten Signatur
.GetInspector.CommandBars.Item(„Insert“).Controls(„Signatur“).Controls(strSignatur). _
Execute
.Display
Hallo Frau Volkenand,
ich hatte heute Abend etwas Zeit mir ihr Problem anzuschauen. Dabei ist eine Lösung für ihr Problem aufgetaucht. Ich habe mir erlaubt dieses in einen Blogartikel zu „verpacken“: https://www.dalecom.de/e-mail-mit-anhang-versenden-ueber-vba-mit-signatur/
Liebe Grüße
Daniel Lensing
Hallo Herr Lensing,
ich arbeite bereits seit einem Jahr mit einem Baustein Ihres Makros und es klappt einwandfrei.
Allerdings komme ich nun zu einem Punkt, der für mich nicht ganz verständlich ist. Ich benötige das Makro für meine Arbeit „Neues PoC“
Die eine Abteilung füllt ein Excel Formular aus und schickt dieses per klick auf den „Send“ Button per Mail an uns raus.
Nun soll jedoch noch ein weiteres Dokument automatisch via VBA hinzugefügt werden.
Wenn ich die folgende angegebene Variante verwenden möchte:
‚You can add other files also like this
‚.Attachments.Add („C:\test.txt“)
Und auf das Laufwerk sowie den Dateinamen verweisen möchte funktioniert es zwar, wenn ich das Makro mit dem „Send“ Button starte, jedoch funktioniert es nicht, wenn meine Kollegen dieses starten sollen.
Können Sie mir eventuell hier weiterhelfen? Ich hoffe das dieses Forum noch aktiv ist.
Hier nochmal das komplette Makro:
Sub Send_active_sheet_via_Outlook()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
‚Copy the ActiveSheet to a new workbook
Sourcewb.Sheets(„Tabelle1“).Copy
Set Destwb = ActiveWorkbook
‚Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2016
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End With
' 'Change all cells in the worksheet to values if you want
' With Destwb.Sheets(1).UsedRange
' .Cells.Copy
' .Cells.PasteSpecial xlPasteValues
' .Cells(1).Select
' End With
' Application.CutCopyMode = False
'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Onboarding Formular " & Format(Now, "dd-mmm-yy")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strText = Sourcewb.Sheets("TextBox").Shapes("TextBox 1").TextFrame.Characters.Text
'strText = TextBox.Shapes("TextBox 1").TextFrame2.TextRange.Text
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.to = "xx"
.CC = "xx"
.BCC = ""
.Subject = "Set-up for POC"
.Body = strText
.Attachments.Add Destwb.FullName
.Attachments.Add ("Y:\POC\TestFile.xltm")
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Send
End With
On Error GoTo 0
.Close savechanges:=False
End With
'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Besten Dank!
Liebe Grüße
Michelle Pennewitz