Microsoft Excel

Herbers Excel/VBA-Archiv

Tabellen Blatt an E-Mail anhängen


Betrifft: Tabellen Blatt an E-Mail anhängen
von: Pascal Werner
Geschrieben am: 17.04.2019 09:47:30

Hallo zusammen,

Ich habe folgendes Problem: Ich würde gerne einige Tabellen blätter in meinem Excel File markieren wollen und diese dann per Knopfdruck eine neue E-Mail erstellen mit den Tabellen blättern jeweils einzeln im Anhang aufgeleistet.

Ich habe hierzu schon etwas gefunden jedoch verbindet dieses Makro die Markierten Tabellen Blätter zu einer Excel Datei beziehungsweise einem Anhang.

Nun wollte ich fragen ob man dieses Makro vielleicht für mich umschreiben könnte.

Makro:


Sub Excel_Sheet_via_Outlook_Senden()
    Dim MyMessage As Object, MyOutApp As Object
    Dim SavePath As String
    Dim AWS As String
    SavePath = "C:\Temp" '"C:\Temp"
    'Kopiert aktuelles Sheet in eine neue Mappe
    'welche nur diese Tabelle enthält
    ActiveWindow.SelectedSheets.Copy
    'Speichert die Datei unter dem Tabellennamen und einem Zeitstempel
    ActiveWorkbook.SaveAs SavePath & "\" & ActiveSheet.Name & "_" & Format(Now, "ddmmyyyy") & ". _
 _
 _
 _
xls"
    '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 = "xxxxxxx@xxx.de"
        .Subject = "Die monatliche Datei" & Date & Time
        'Hier wird die temporär gespeicherte Datei als
        'Attachment zugefügt
        .Attachments.Add AWS
        'Hier wird eine normale Text Mail erstellt
        '.body = "Die monatliche Datei" & vbCrLf & "Bitte bearbeiten."
        'Hier wird die HTML Mail erstellt
        .HTMLBody = "Anbei die monatliche Datei." & vbCrLf & "Bitte bearbeiten."
        '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
    Set MyOutApp = Nothing
    Set MyMessage = Nothing
End Sub

Danke & Viele Grüße,

Pascal

  

Betrifft: AW: Tabellen Blatt an E-Mail anhängen
von: Nepumuk
Geschrieben am: 17.04.2019 10:22:05

Hallo Pascal,

teste mal:

Option Explicit

Public Sub Excel_Sheet_via_Outlook_Senden()
    Const SavePath As String = "C:\Temp\" '"C:\Temp\"
    Dim MyMessage As Object, MyOutApp As Object
    Dim objSheet As Object
    Dim strSheetName As String
    Dim ialngIndex As Long
    Dim AWS() As String
    
    With ActiveWindow.SelectedSheets
        ReDim AWS(1 To .Count)
        For ialngIndex = 1 To .Count
            'Kopiert das Sheet in eine neue Mappe
            'welche nur diese Tabelle enthält
            Call .Item(ialngIndex).Copy
            'Speichert die Datei unter dem Tabellennamen und einem Zeitstempel
            With ActiveWorkbook
                Call .SaveAs(Filename:=SavePath & ActiveSheet.Name & _
                     "_" & Format(Date, "ddmmyyyy") & ".xls", FileFormat:=xlExcel8)
                'Mappenname wird an Variable übergeben
                'und anschliessend gleich geschlossen
                AWS(ialngIndex) = .FullName
                .Close
            End With
        Next
    End With

    'InitializeOutlook = True
    Set MyOutApp = CreateObject("Outlook.Application")
    'Nachrichtenobject erstellen
    Set MyMessage = MyOutApp.CreateItem(0)
    With MyMessage
        .To = "xxxxxxx@xxx.de"
        .Subject = "Die monatliche Datei " & Now
        'Hier wird die temporär gespeicherte Datei als
        'Attachment zugefügt
        For ialngIndex = 1 To UBound(AWS)
            .Attachments.Add AWS(ialngIndex)
        Next
        'Hier wird eine normale Text Mail erstellt
        '.body = "Die monatliche Datei" & vbCrLf & "Bitte bearbeiten."
        'Hier wird die HTML Mail erstellt
        .HTMLBody = "Anbei die monatliche Datei." & vbCrLf & "Bitte bearbeiten."
        'Hier wird die Mail nochmals angezeigt
        .Display
        'Hier wird die Mail gleich in den Postausgang gelegt
        '.Send
    End With
    'Hier wird die temporäre Datei wieder gelöscht
    For ialngIndex = 1 To UBound(AWS)
        Kill AWS(ialngIndex)
    Next
    Set MyOutApp = Nothing
    Set MyMessage = Nothing
End Sub

Gruß
Nepumuk


  

Betrifft: AW: Tabellen Blatt an E-Mail anhängen
von: Pascal Werner
Geschrieben am: 17.04.2019 10:42:01

Ja Sehr gut es klappt. :)

was mich nur stört ist das die Kompatibilitätsprüfung kommt und man dann auf Weiter klicken muss.
Kann man diese Prüfung irgendwie ignorieren?

Danke & Grüße,

Pascal


  

Betrifft: AW: Tabellen Blatt an E-Mail anhängen
von: Nepumuk
Geschrieben am: 17.04.2019 11:27:08

Hallo Pascal,

kann ich nicht nachvollziehen. Ich habe es mit Excel 2010 und 2013 getestet. Da kommt keine Meldung. Ich würde die Mappen aber sowieso als xlsx speichern. Dazu in der SaveAs-Methode die Dateiendung anpassen und als Format xlOpenXMLWorkbook angeben.

Gruß
Nepumuk


  

Betrifft: AW: Tabellen Blatt an E-Mail anhängen
von: Pascal Werner
Geschrieben am: 17.04.2019 11:59:19

Alles klar, super ich Danke dir.

:)