AW: Tabellenblatt mit Thunderbird versenden
17.08.2006 12:25:52
stefanseevetal
Hallo Düppi!
Hier ein Beispiel, wie es bei mir läuft. Ich hatte vor ein paar Wochen eine ähnliche Frage gepostet und netterweise hier im Forum diesen Code erhalten.
Sub NachrichtVersenden()
Dim Nachricht As Object, OutApp As Object
Dim SavePath As String
Dim istOffen As Boolean
Dim AWS As String
Dim SName As String
Dim Abfrage as String
Abfrage = MsgBox("Wollen Sie die e-Mail wirklich senden?", vbQuestion + vbYesNo, "Achtung")
If Abfrage = vbNo Then Exit Sub
SName = ActiveSheet.Name
' Die aktuelle Schadensmeldung wird in eine separate Datei kopiert, um diese später zu senden.
On Error GoTo ERRORHANDLER
SavePath = ThisWorkbook.Path
On Error Resume Next
Set OutApp = GetObject(, "Outlook.Application")
If Err.Number = 429 Then
Set OutApp = CreateObject("Outlook.application")
istOffen = False
End If
istOffen = True
On Error GoTo ERRORHANDLER
' Name unter der das kopierte Tabellenblatt gespeichert wird:
AWS = SavePath & "\" & "Test "& SName & ".xls"
ActiveSheet.Copy
ActiveWorkbook.SaveAs AWS
ActiveWorkbook.Close
' Die kopierte Datei wird per Outlook gesendet.
InitializeOutlook = True
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = klaus@test.de
.CC = muster@test.de
.Subject = "Test " & SName & " " & Date & " " & Time
.Attachments.Add AWS
.HTMLBody = "Im Anhang erhalten Sie ?!" & vbCrLf & SName
'.Display ' die Mail wird vorm Senden angezeigt.
.OriginatorDeliveryReportRequested = True ' Übermittlungsbestätigung
.ReadReceiptRequested = True ' Lesebestätigung
.Send ' Die Mail wird automatisch gesendet.
Kill AWS ' Das kopierte Tabellenblatt wird gelöscht.
End With
' Outlook wird geschlossen, wenn es vorher nicht offen war.
If Not istOffen Then
OutApp.Quit
End If
Set OutApp = Nothing
Set Nachricht = Nothing
Exit Sub
ERRORHANDLER:
MsgBox "Bei der Übermittlung ist ein Fehler ausgetreten! Die E-Mail konnte nicht gesendet werden. Bitte überprüfen Sie, ob Outlook richtig konfiguriert ist!", vbExclamation, "Achtung"
Kill AWS
Exit Sub
End Sub
Gruß,
Stefan