Einzelnes Datenblatt senden

Hallo,

ich habe bei euch folgenden Code zum versenden einzelner Tabellenblätter gefunden.
Ist es möglich das nicht nur die Betreffzeile angezeigt wird sondern das man auch einen Text schreiben kann damit man das Tabellenblatt erklären kann.

Sub SendActiveSheet()
Dim objSourceWb As Workbook
Dim objNewWb As Workbook
Dim strSubjectline As String
Dim strRecipient As String
Dim strTempPath As String

On Error GoTo SendError
strSubjectline = InputBox _
(Prompt:=„Wollen Sie das aktive Blatt senden?“ & _
String(2, vbCr) & _
„Geben Sie eine Betreffzeile ein“ & _
" oder klicken Sie auf Abbrechen.", _
Title:=„Aktives Blatt senden“)
If strSubjectline „“ Then
strRecipient = InputBox _
(„Bitte E-Mail-Empfaenger eingeben:“, _
Title:=„Aktives Blatt senden“)
If strRecipient „“ Then
Application.ScreenUpdating = False
Set objSourceWb = ActiveWorkbook
ActiveSheet.Copy
Set objNewWb = ActiveWorkbook
With objNewWb
.SaveAs "Auszug aus " & objSourceWb.Name
strTempPath = .FullName
.SendMail Recipients:=strRecipient, _
Subject:=strSubjectline
.Close SaveChanges:=False
Kill strTempPath
End With
Application.ScreenUpdating = True
End If
End If

SendEnd:
Set objNewWb = Nothing
Set objSourceWb = Nothing
Exit Sub

SendError:
MsgBox Prompt:="Fehler beim Senden des Blatts " & _
„(“ & Err.Number & „):“ & vbCr & _
Err.Description
Resume SendEnd
End Sub

Freundliche Grüsse
Jörn

Hallo Joetie,

schau mal hier:

http://www.office-loesung.de/ftopic217576_0_0_asc.php

Gruß
Reinhard

Hallo Reinhard,

vielen Dank für deine schnelle Hilfe.

Der Code, für einzelnes Tabellenblatt senden, entspricht was ich gesucht habe.

Kleines Manko hat dieser Code. Das kopierte Tabellenblatt wird nicht automatisch, nach dem senden, gelöscht.

Sub AktiveArbeitsmappeAlsAnhang()
Application.DisplayAlerts = False
Dim aws As String
Dim olapp As Object
ActiveWorkbook.Save
aws = ActiveWorkbook.FullName
Set olapp = CreateObject(„Outlook.Application“)
With olapp.CreateItem(0)
.To = „empfä[email protected]
'.cc = „[email protected],[email protected],[email protected]“ 'optional Kopie an
'.bcc = „[email protected],[email protected],[email protected]“ 'optional Blindkopie an
.Subject = „Text“ ’ Betreff optional
.HtmlBody =„Text“ ’ Body optional
'.ReadReceiptRequested = True 'optional Lesebestätigung anfordern
.Attachments.Add aws
.Display
'SendKeys „%s“, True ’ optional Mail sofort senden
End With
Set olapp = Nothing
Application.DisplayAlerts = True
End Sub

Kennst du dafür vieleicht auch eine Lösung?

Vielen Dank
Jörn

Der Code, für einzelnes Tabellenblatt senden, entspricht was
ich gesucht habe.
Kleines Manko hat dieser Code. Das kopierte Tabellenblatt
wird nicht automatisch, nach dem senden, gelöscht.

Hallo Jörn,

in deinem ersten Code, der m.E. gar nicht laufen kann, da sind doch zwei End If zuviel, haste doch die Befehle dazu:

.Close SaveChanges:=False
Kill strTempPath

Kommste klar damit?

Gruß
Reinhard

Hallo Reinhard,

konnte leider nicht vorher Antworten.

Vielen Dank für deine Hilfe.
Das bekomme ich hoffentlich hin,sonst wende ich mich nochmal an dich.

mit den anderen Code habe ich, seit dem ich ihn benutze, keine Probleme
ausser das er eben kein Text anzeigt.

Was jetzt natürlich besser ist.

Gruß
Jörn