Arbeitsblatt ohne Code etc. Mailen

Hallo zusammen,
ich habe zwei Marko's im Netz gefunden die ich gerne zusammen führen möchte ! Aber wie, als nicht VBA Experte!
Beide versenden auf die ein oder andere weise das aktive Arbeitsblatte als E- Mail!
Der erste Code BlattMailen hat folgende Prozedur:
Das aktive Arbeitsblatt wird in C\Temp geschrieben löscht alle Markos und Formeln. Der Registername (Arbeitsblattname) ist auch der Dateiname. Nach dem in Outlook die Datei versendet wird, wird die Temp. Datei gelöscht!
Dies gefällt mir gut und sollte auch so bleiben!
Darüberhinaus würde ich gerne noch ein Kurztext mit ein bringen!
z. B.
Hallo zusammen,
anbei erhaltet Ihr die gewünschte Datei: ......hier ist noch einmal der Dateiname aufgeführt....
zu Durchsicht!
MFG
Lemmi
.. Dies ist im zweiten Marko (SerienMail) eingebunden, ich weis aber nicht wie ich es dort mit einbringen kann!
Darüberhinaus sucht das zweite Marko in einem vorbestimmten Arbeitsblatt z. B. Tabelle 2 nach abgelegten Mail- Adressen. Diese Funktion würde ich gerne auch mit ein gebunden haben wollen!
Ist es auch möglich bedingte Formatierungen zu ersetzten?
https://www.herber.de/bbs/user/45804.xls
Gruß
lemmi

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo zusammen,
anbei die richtige Datei! Sorry!

Die Datei https://www.herber.de/bbs/user/45810.xls wurde aus Datenschutzgründen gelöscht


Sub BlattMailen()
Dim AktBlatt As String
Dim Pfad As String
Dim AktDatei As String
Dim Dateiname As String
AktBlatt = ActiveSheet.Name
AktDatei = ActiveWorkbook.Name
Pfad = ActiveWorkbook.Path
' TEMP-Dateiname festlegen
Dateiname = Pfad & Application.PathSeparator & AktBlatt & ".xls"
Sheets(AktBlatt).Cells.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("B3").Select
ActiveSheet.Name = AktBlatt
Application.CutCopyMode = False
' Datei speichern
ActiveWorkbook.SaveAs _
Filename:=Dateiname, _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False
' Datei versenden
ActiveWorkbook.SendMail ""
' TEMP-Datei schließen und löschen
ActiveWorkbook.Close False
'If MsgBox("Temporäre Datei " & Dateiname & " löschen?", vbYesNo) = vbYes Then
Kill Dateiname
'End If
End Sub

Der Zweite Code
' Serienbriefe kann jeder :-) Warum nicht eine Serien-EMail verschicken?
' Hat man die EMail-Adressen aller Empfänger in einer Excel-Tabelle
' eingetragen, ist das gar kein Problem. Falls gewünscht, kann sogar
' eine Anlage beigefügt werden:


Sub Serien_EMail_mit_Anhang()
Dim outObj As Object
Dim Mail As Object
Dim WS As Worksheet
Dim Zeile As Integer
Dim SpalteMailadressen As Integer
Set WS = ActiveSheet
' Automatisch Spalte ermitteln, in der die Mailadressen stehen:
SpalteMailadressen = WS.Range("2:2").Find("@", LookIn:=xlValues).Column
' Alle Zeilen abarbeiten
For Zeile = 2 To WS.UsedRange.Rows.Count
Set outObj = CreateObject("Outlook.Application")
Set Mail = outObj.CreateItem(0)
With Mail
' Betreff
.Subject = "Information"
' Text in der Mail
.Body = "Sehr geehrte Damen und Herren," & Chr(13) & Chr(13) & _
"dies ist eine automatisch generierte E-Mail." & Chr(13) & _
Chr(13) & "Viele Grüße " & Chr(13) & _
Environ("Username") & Chr(13)
' Empfängeradresse aus ermittelter Spalte
.To = WS.Cells(Zeile, SpalteMailadressen).Value
.CC = "" ' Auf Wunsch: Kopieempfänger
.BCC = "" ' Auf Wunsch: Blanko-Kopieempfänger
' Datei-Anhang:
.Attachments.Add "C:\Eigene Dateien\EgberLamminger"
End With
Mail.Send ' Mail wird sofort verschickt
' Mail.Display ' Alternativ: Mail erstmal anzeigen
Set Mail = Nothing
Set outObj = Nothing
Next
End Sub

Gruß
Lemmi

Beliebteste Forumthreads (12 Monate)

Arbeitsblatt ohne Code etc. Mailen

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread