Tabellenblatt per Mail mit Anpassungen

Hallo liebe Herber-Gemeinde,
habe den halben Vormittag damit verbracht, ein Makro zu finden was folgendes kann:
- aus einen Tabellenblatt heraus, ein Mail (Outlook) generieren
- das aktuelle Tabellenblatt als Excel Datei anhängen, wobei sich der Name der anzuhängenden Datei aus zwei Zellen im Tabellenblatt (A1 und D1) zusammensetzt
- der Betreff Text sich ebenfalls aus den Zellen A1 und D1 füllen soll
- der Empfänger (Mailadresse) in einer weiteren Zelle des Tabellenblattes steht (z.B. A2)
- und wenn das Makro sich nach dem Laden in Outlook noch selbst deaktiviert, damit keine weiteren (sinnlosen) Mails damit erstellt werden können
Das müsste es eigentlich sein; wäre für jede Hilfe dankbar denn ich kann immer wieder nur Teile meiner Anforderungen realisieren.
Beste Grüße aus Düsseldorf,
Thorsten

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Mail_ActiveSheet() 'Working in Excel 2000-2016 'For Tips see: http://www. _ rondebruin.nl/win/winmail/Outlook/tips.htm 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 ActiveSheet.Copy Set Destwb = ActiveWorkbook 'Determine the Excel version and file extension/format With Destwb If Val(Application.Version) soll auf Zelle A2 zugreifen und die dort hinterlegte _ Adresse nehmen Hier soll der Betreff zusammengesetzt aus den _ Zellen A1 und D1 rein" .Body = "Liebe KollegInnen,angehängt finden Sie die Datei zur Erfassung _ der Daten und Kommentare für den kommenden Quartalsbericht." .Attachments.Add Destwb.FullName 'You can add other files also like this '.Attachments.Add ("C:\test.txt") .Send 'or use .Display 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

Hallo Thorsten,
ich kann den nachfolgenden Code nicht testen weil ich einen Mac habe.
Probier trotzdem mal:

Sub Mail_ActiveSheet()
'Working in Excel 2000-2016
'http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
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
Dim Betreff As String
Dim Mailadresse As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
Betreff = ActiveSheet.Range("A1").Value & " " & ActiveSheet.Range("D1").Value
Mailadresse = ActiveSheet.Range("A2").Value
'Copy the ActiveSheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) TempFileName = Betreff
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
 .to = Mailadresse
.CC = ""
.BCC = ""
 .Subject = Betreff
.Body = "Liebe KollegInnen, angehängt finden Sie die Datei zur Erfassung der Daten  _
und Kommentare für den kommenden Quartalsbericht."
.Attachments.Add Destwb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send   'or use .Display
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
Set Sourcewb = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Gruß
Klaus

Sub Mail_ActiveSheet() 'Working in Excel 2000-2016 'http://www.rondebruin.nl/win/winmail/Outlook/tips.htm 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 Dim Betreff As String Dim Mailadresse As String Dim MyDate As String With Application .ScreenUpdating = False .EnableEvents = False End With Set Sourcewb = ActiveWorkbook Betreff = ActiveSheet.Range("A1").Value & " " & ActiveSheet.Range("D1").Value Mailadresse = ActiveSheet.Range("A2").Value MyDate = ActiveSheet.Format(Range("B2").Value, dd.mm.yyyy) 'Copy the ActiveSheet to a new workbook ActiveSheet.Copy Set Destwb = ActiveWorkbook 'Determine the Excel version and file extension/format With Destwb If Val(Application.Version) "Liebe KollegInnen, angehängt finden Sie die Datei zur Erfassung der _ Daten und Kommentare für den kommenden Quartalsbericht. Abgabetermin: " & MyDate .Attachments.Add Destwb.FullName 'You can add other files also like this '.Attachments.Add ("C:\test.txt") .Send 'or use .Display 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 Set Sourcewb = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub

Beliebteste Forumthreads (12 Monate)

Tabellenblatt per Mail mit Anpassungen

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

soll auf Zelle A2 zugreifen und die dort hinterlegte _ Adresse nehmen

Hier soll der Betreff zusammengesetzt aus den _ Zellen A1 und D1 rein

&MyDate

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Tabellenblatt per Mail mit Anpassungen

19 Beiträge zum Forumthread Beiträge zu diesem Forumthread

soll auf Zelle A2 zugreifen und die dort hinterlegte _ Adresse nehmen

Hier soll der Betreff zusammengesetzt aus den _ Zellen A1 und D1 rein

&MyDate

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread