Im im Code vermerkten Link zu
https://www.online-excel.de/excel/singsel_vba.php?f=86 befindet sich ja auch ein Hinweis zum Versenden einzelner Blätter (weiter unten)!
Ich muss jetzt tatsächlich erst mal weiter arbeiten, kann Dir aber später einen angepassten Code geben, wenn Du nicht klar kommen solltest.
Vielen Dank. Ich habe nur den oberen Code gesehen. :92:
Mit einem Blatt funktioniert es. Habe versucht es auf weitere Blätter zu erweitern, aber wahrscheinlich nicht an der richtigen Stelle eingefügt.
Zudem müssten wir den Code noch so abändern, dass nur die Werte mit geschickt werden und nicht die Verknüpfungen.
Im Moment schaut es so aus:
Code:
Sub Excel_Sheet_via_Outlook_Senden()
Dim MyMessage As Object, MyOutApp As Object
Dim SavePath As String
Dim AWS As String
Dim WS_Count As Integer
Dim I As Integer
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 3 To WS_Count
SavePath = "C:" '"E:\Eigene Dateien"
'Kopiert aktuelles Sheet in eine neue Mappe
'welche nur diese Tabelle enthält
ActiveSheet.Copy
'Speichert die Datei unter dem Tabellennamen und einem Zeitstempel
ActiveWorkbook.SaveAs SavePath & "\" & ActiveSheet.Name & "_" & "Mehrstunden" & Worksheets("Gesamt").Range("K1").Value & ".xlsx"
'Mappenname wird an Variable übergeben
'und anschliessend gleich geschlossen
With ActiveWorkbook
AWS = .FullName
.Close
End With
'InitializeOutlook = True
Set MyOutApp = CreateObject("Outlook.Application")
'Nachrichtenobject erstellen
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.To = Worksheets(I).Range("J1").Value
.Subject = "Mehrstundenliste der " & Worksheets("Gesamt").Range("K1").Value 'Date & Time
'Hier wird die temporär gespeicherte Datei als
'Attachment zugefügt
.Attachments.Add AWS
'Hier wird eine normale Text Mail erstellt
.Body = "Sehr geehrte Kolleginnen und Kollegen" & vbCrLf & vbCrLf & _
"anbei erhalten Sie die Liste " & Worksheets("Gesamt").Range("K1").Value & _
" mit der Bitte um Prüfung, Korrektur und Rückgabe bis spätestens " & Worksheets("Gesamt").Range("L1").Value & "." & vbCrLf & vbCrLf & _
"LG." & vbCrLf & vbCrLf & _
"Marianne Musterfrau" & vbCrLf & _
"Personalsachbearbeiterin" & vbCrLf & _
"Tel.: 627"
'Hier wird die HTML Mail erstellt
'.HTMLBody = "Das ist ein Test." & vbCrLf & "Bitte ignorieren."
'Hier wird die Mail nochmals angezeigt
.Display
'Hier wird die Mail gleich in den Postausgang gelegt
.Send
'Hier wird die temporäre Datei wieder gelöscht
Kill AWS
End With
'MyOutApp.Quit
Set MyOutApp = Nothing
Set MyMessage = Nothing
Next I
End Sub
LG.
Peggy
Hi Peggy,
ich habe zweimal dein Makro in Codetags gesetzt. Benutze bitte auch (zumindest bei längeren Codes) den 5. Schalter von rechts in der zweiten Iconleiste. Der Beitrag bleibt dann etwas übersichtlicher und dadurch besser lesbar.
Vielen Dank erst einmal für Eure Hilfe,
mit viel Tüfteln habe ich es jetzt so hin bekommen, wie ich es möchte. Das schaut nun so aus:
Code:
Sub Excel_Sheet_via_Outlook_Senden()
Dim MyMessage As Object, MyOutApp As Object
Dim SavePath As String
Dim AWS As String
Dim WS_Count As Integer
Dim I As Integer
WS_Count = ActiveWorkbook.Worksheets.Count
Worksheets("Vorgesetzte").Activate
For I = 3 To WS_Count
ActiveSheet.Next.Activate
SavePath = "Z:\Dokumente\Fuchs" '"E:\Eigene Dateien"
'Kopiert aktuelles Sheet in eine neue Mappe
'welche nur diese Tabelle enthält
With ActiveSheet.UsedRange
.Value = .Value
End With
ActiveSheet.Copy
'Speichert die Datei unter dem Tabellennamen und einem Zeitstempel
ActiveWorkbook.SaveAs SavePath & "\" & ActiveSheet.Name & "_" & "Mehrstunden" & ActiveSheet.Range("h1").Value & ".xlsx"
'Mappenname wird an Variable übergeben
'und anschliessend gleich geschlossen
With ActiveWorkbook
AWS = .FullName
.Close
End With
'InitializeOutlook = True
Set MyOutApp = CreateObject("Outlook.Application")
'Nachrichtenobject erstellen
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.To = Worksheets(I).Range("J1").Value
.Subject = "Mehrstundenliste der " & ActiveSheet.Range("h1").Value 'Date & Time
'Hier wird die temporär gespeicherte Datei als
'Attachment zugefügt
.Attachments.Add AWS
'Hier wird eine normale Text Mail erstellt
.Body = "Sehr geehrte Kolleginnen und Kollegen" & vbCrLf & vbCrLf & _
"anbei erhalten Sie die Mehrstundenliste der " & ActiveSheet.Range("h1").Value & _
" mit der Bitte um Prüfung, Korrektur und Rückgabe bis spätestens " & ActiveSheet.Range("i1").Value & "." & vbCrLf & vbCrLf & _
"LG." & vbCrLf & vbCrLf & _
"Marianne Musterfrau" & vbCrLf & _
"Personalsachbearbeiterin" & vbCrLf & _
"Tel.: 627"
'Hier wird die HTML Mail erstellt
'.HTMLBody = "Das ist ein Test." & vbCrLf & "Bitte ignorieren."
'Hier wird die Mail nochmals angezeigt
'.Display
'Hier wird die Mail gleich in den Postausgang gelegt
.Send
'Hier wird die temporäre Datei wieder gelöscht
Kill AWS
End With
'MyOutApp.Quit
Set MyOutApp = Nothing
Set MyMessage = Nothing
Next I
End Sub
Hoffe es funktioniert dann auch noch in der Praxis.
LG.
Peggy