E-Mail (automatisch) erstellen
Kann Excel auf Knopfdruck
- eine E-Mail generieren ?- einen beliebigen Verteiler einsetzen ?
- und eine Datei anhängen ?
Bsp: Ein Excel-Bereich
soll inkl Formatierung
per E-Mail verschickt
werden.
KLARO, per Excel-VBA wird einfach...
mit einem kleinen,
oder auch grossen Excel-Verteiler
...diese E-Mail gezaubert !! :-)
Das VBA-Progrämmchen:
# erstellt den Verteiler (A)
# erstellt den Betreff (B)
# fügt eine Datei ein (C)
# kopiert einen Zellbereich (D)
# schreibt was Nettes ;-) (E)
# macht Spaß weil's so schnell geht. (A-E)
Wie geht das ???
1. VBA-Editor öffnen, dafür Alt und F11 drücken
2.
Im Projekt-Fenster (links) mit der rechten Maustaste ein Modul anlegen: z.B. "Email"
oder
ein vorhandenes Modul per Doppelklick auswählen.
Anschliessend die beiden folgenden Code-Fragemente einfügen,
- eine Sub (siehe 3.)
- und eine Function (siehe 4.)
Tipp: Einfach hier markieren und kopieren.
3. Folgendes im Quellcode-Fenster eingeben. (die Sub)
VBA
Public Sub myEMail()
'*****************************************************
' Diese Sub kopiert einen Excel-Zellbereich in eine
' automatisch erstellte E-mail.
' Der Verteiler wird anhand der "X" in Register
' 'Verteiler' zusammengesetzt.
'*****************************************************
Dim olApp As Object
Set olApp = CreateObject("Outlook.Application")
Dim j As Integer
Dim rngBereich As Range
' Zell-Bereich selektieren
Set rngBereich = Nothing
Range("A2:F18").Select
Set rngBereich = Selection.SpecialCells(xlCellTypeVisible)
' E-Mail erstellen/zusammensetzen
With olApp.CreateItem(0)
' Empfänger anhand der "X" zusammensetzen:
j = 6 ' 6 ist die Zeile der ersten Mail-Adresse
While Worksheets("Verteiler").Cells(j, 3).Value <> ""
If (Worksheets("Verteiler").Cells(j, 2).Value = "X") Then
.Recipients.Add Worksheets("Verteiler").Cells(j, 3).Value
End If
j = j + 1
Wend
' Betreff:
.Subject = "Protokoll-Info, " & Format(Now, "dd.mm.yy h:mm") & "Uhr"
' Dateianhang:
.Attachments.Add "C:\temp\test.txt"
' Zellbereich in die mail kopieren
.HTMLBody = fktRngToHTML(rngBereich)
' E-Mail anzeigen
.display
' E-Mail automatisch verschicken
'.send 'dafür das Hochkomma wegnehmen
End With
Set olApp = Nothing
Set rngBereich = Nothing
End Sub
4. Folgendes ebenso eingeben. (die Function)
VBA
Function fktRngToHTML(rng As Range) As String
'********************************************************
' Funktion gibt den rng-Zellbereich als html-Text zurück
'********************************************************
' Variablen...
Dim objFs As Object, objTs As Object, wbTemp As Workbook, sFile As String
'--String für tempor. html-Datei inkl Pfad zusammensetzen
sFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
' Kopieren der übergebenen Zellen
rng.Copy
' Trick_1: Temporäre Excel-Mappe erzeugen
Set wbTemp = Workbooks.Add(1)
' Die kopierten Zellen in die temp. Mappe pasten
With wbTemp.Sheets(1).Cells(1)
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues, , False, False
.PasteSpecial xlPasteFormats, , False, False
.Select
End With
Application.CutCopyMode = False
On Error Resume Next
wbTemp.Sheets(1).DrawingObjects.Visible = True
wbTemp.Sheets(1).DrawingObjects.Delete
On Error GoTo 0
' Ein Sätzchen unten anfügen
wbTemp.Sheets(1).Cells(Cells(Rows.Count, 2).End(xlUp).Row + 3, 1).Value = _
"Diese E-Mail wurde automatisch erstellt am: " & Date & ", mfG"
' Trick_2: Die temp Mappe in eine html-Datei "publishen"
wbTemp.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=sFile, _
Sheet:=wbTemp.Sheets(1).Name, _
Source:=wbTemp.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic).Publish True
' Die html-Datei wieder als Text einlesen, => Rückgabewert dieser Fkt
Set objFs = CreateObject("Scripting.FileSystemObject")
Set objTs = objFs.GetFile(sFile).OpenAsTextStream(1, -2)
fktRngToHTML = objTs.ReadAll
objTs.Close
fktRngToHTML = Replace(fktRngToHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
' Temp Mappe schliessen
wbTemp.Close savechanges:=False
' Temp Mappe/Datei löschen
Kill sFile
Set objTs = Nothing: Set objFs = Nothing: Set wbTemp = Nothing
End Function
5. Ach ja:
# Bitte noch einen hübschen button erstellen.
Dafür einfach unter 'Einfügen, Illustrationen, Formen' ein Rechteck oder ähnliches zeichnen,
beschriften und mit der rechten Maustaste die eben erstellte VBA-Sub "MyEmail" zuweisen.
# Outlook vorher öffnen.
6. Ausprobieren und freuen.
