AW: E-Mail per Makro einbinden
09.05.2006 14:45:31
Rolli
Hallo Tina,
anbei ein Vorschlag.
Kopiere den Code einfach in ein Modul und schon kanns losgehen.
Option Explicit
Public Type rrEmailAdr
rrAdr As String
rrDescr As String
End Type
Sub EmailSenden()
Dim Empfänger(5) As rrEmailAdr, Empfängerliste$, answer$, RecipientAdr() As String, i%
On Error Resume Next
'EMail Adressen
Empfänger(1).rrAdr = "Vorname.Nachname@Provider.de"
Empfänger(2).rrAdr = "Vorname.Nachname@Provider.de"
Empfänger(3).rrAdr = "Vorname.Nachname@Provider.de"
Empfänger(4).rrAdr = "Vorname.Nachname@Provider.de"
Empfänger(5).rrAdr = "Vorname.Nachname@Provider.de"
'Text für Empfänger
Empfänger(1).rrDescr = "Vorname, Nachname"
Empfänger(2).rrDescr = "Vorname, Nachname"
Empfänger(3).rrDescr = "Vorname, Nachname"
Empfänger(4).rrDescr = "Vorname, Nachname"
Empfänger(5).rrDescr = "Vorname, Nachname"
Empfängerliste = ""
ReDim RecipientAdr(UBound(Empfänger()))
For i = 1 To UBound(Empfänger())
Empfängerliste = Empfängerliste + Empfänger(i).rrDescr + vbCrLf
RecipientAdr(i) = Empfänger(i).rrAdr
Next
answer = MsgBox("Soll dieser Auftrag an folgende Personen gesendet werden ?" + vbCrLf + vbCrLf + Empfängerliste, _
vbYesNo + vbQuestion, ThisWorkbook.Name)
If answer = vbYes Then
On Error Resume Next
'Hier wird diese Arbeitsmappe an die oben genannten Empfänger gesendet.
'Application.ThisWorkbook.SendMail (Empfängerliste, Betreff, Empfangsbestätigung Ja/Nein)
Application.ThisWorkbook.SendMail RecipientAdr(), ThisWorkbook.Name, False
If Err.Number = 0 Then
MsgBox ThisWorkbook.Name + " wurde an folgende Empfänger gesendet:" + vbCrLf + vbCrLf _
+ Empfängerliste, vbOKOnly + vbInformation, ThisWorkbook.Name
Else
MsgBox ThisWorkbook.Name + " konnte nicht gesendet werden" + vbCrLf + vbCrLf _
+ Empfängerliste, vbOKOnly + vbCritical, ThisWorkbook.Name
End If
Else
End If
If Err.Number <> 0 Then ErrMsg "EmailSenden", Err.Number, Err.Description, "Überprüfen Sie die Email Software," & vbCrLf & "eventuell hat ihr Postfach die maximale Grösse erreicht."
End
End Sub
Sub ErrMsg(t$, en%, ed$, Optional at$)
Dim P$
If at = "" Then
P = "Bei der Ausführung des Programms trat ein Fehler auf!" & vbCrLf & _
"Bitte erstellen Sie einen Bildschirmausdruck und zeigen diesen Herrn ......!" & vbCrLf & vbCrLf & _
"Err.Nr.:" & vbTab & en & vbCrLf & "Err.Desc:" & vbTab & ed
Else
P = "Bei der Ausführung des Programms trat ein Fehler auf!" & vbCrLf & _
"Bitte erstellen Sie einen Bildschirmausdruck und zeigen diesen Herrn ......!" & vbCrLf & at & vbCrLf & _
"Err.Nr.:" & vbTab & en & vbCrLf & "Err.Desc:" & vbTab & ed
End If
MsgBox P, vbCritical + vbOKOnly, t & " @ Modul1"
Err.Clear
End Sub
Gruß
Rolli