Bereich aus Tabelle in eMail Boddy einfügen
24.03.2016 12:48:24
Andreas
Nun habe ich versucht dieses Makro in meine andere Excel Arbeitsmappe aus der ich die eMail ü _
ber eine Schaltfläche aus Excel herraus versenden möchte in das Makro
Sub eMail_Excel_Workbook_via_Outlook_Senden()
einzubinden. Das kriege ich aber nicht hin. Kann mir einer dabei helfen, oder den Code im Makro _
_
(
Sub eMail_Excel_Workbook_via_Outlook_Senden()) dementsprechend anpassen?
Wäre für eine Hilfe sehr dankbar
Sub Send_OriginalRange_from_Excel()
'Geht nur ab Office 2000 und höher
'Ohne Select geht es in diesem Fall nicht :-))
'Sendet den aktuell markierten Bereich
With Selection
'Das anzeigen der Envelope Commandbar ist unabdingbar
'Hier wird EXCEL selbst als "Mail-Client" verwendet.
ActiveWorkbook.EnvelopeVisible = True
'Nun werden die Adressen vergeben
With ActiveSheet.MailEnvelope
'Der Betreff
.item.Subject = "Die aktuellen Daten"
'Dies ist der eigentliche "Body"-Text
.Introduction = "Das ist der Einleitungstext." & vbCrLf & "mit einer zweiten Zeile"
'item.To = "eMailEmpfänger.de"
'.Display 'wenn ich Display aktiviere erscheint der Debugger und markiert mir _
_
die Zeile gelb
'.item.Send
End With
End With
ActiveWorkbook.EnvelopeVisible = False
End Sub
++++++++++
'sendet die aktuelle Datei an e- Mail Empfänger über Outlock
Sub eMail_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) "xlsm" Then
'Nein > Speicherdialog aufrufen
'Application.Dialogs(xlDialogSaveAs).Show
ActiveWorkbook.SaveAs Filename:= _
"N:\Ablagen\MeineDatei.xlsm"
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 = "eMailEmpfänger.de"
'Betreff
.Subject = "Teilnehmerliste"
'Hier wird ein normaler Text erstellt
'.Body = "Mail für normalen Textempfang"
.HTMLBody = "Hallo Frau Mustermann,
" & _
"
Hier die neuen Teilnehmer die ab Montag die Maßnahme beginnen sollen" & vbCrLf & _"
" & _"
" & _"
" & _"
schönes Wochenende _
b>
" & _"Mit freundlichen Grüßen
" & _"
Ich
" & _"Telefon: 1111 111-645
" & _"Telefax: 111 111-660
" & _"E -Mail: eMailEmpfänger.de
" & _"
Ort Musterstadt
" & _"Musterstraße 1
" & _"Musterort
.Attachments.Add AWS
'Hier wird eine HTML Mail erstellt
'Dies kann zu Problemen 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
Für eine Hilfe wäre ich sehr dankbar
liebe Grüße Andreas