Office: (Office 2013) Zwei Tabellen per Email versenden

Hallo,
ich habe zwei Tabellenblätter aus einer Mappe per Schaltfläche an einem Email Empfänger zu versenden.
Den Code für den aktiven Sheet habe ich, aber wie kann ich den ändern um eben zwei Tabellen zu versenden...?

Den Code den ich benutze ist folgender:
Sub XXX_Schaltfläche9_Klicken()
Application.DisplayAlerts = False
'** Das aktive Tabellenblatt wird über Outlook versendet
'** Dimensionierung der Variablen
Dim strBlatt As String
Dim strDatei As String
Dim strPfad As String
Dim outObj As Object
Dim Mail As Object
Dim strBodyText As String
Set outObj = CreateObject("Outlook.Application")
Set Mail = outObj.CreateItem(0)
'** Pfad für temporäre Zwischenspeicherung angeben
strPfad = "C:\Temp" 'entsprechend anpassen
'** Aktuelles aktives Blatt in neue Arbeitsmappe kopieren
strBlatt = ActiveSheet.Name
'** Gewähltes Tabellenblatt kopieren
Sheets(strBlatt).Copy
'** Blatt temporär in vorgegebenes Verzeichnis abspeichern
ActiveWorkbook.SaveAs strPfad & "\" & ActiveSheet.Name

'** Pfad und Dateiname der neuen Datei zwischenspeichern
strDatei = ActiveWorkbook.FullName

'** Body-Text festlegen
strBodyText = "Hallo Herr XXX." & vbCrLf & vbCrLf & "anbei die aktuelle Auftragsliste für das ..." & vbCrLf & vbCrLf & "Gruß ..."

'** Mail erzeugen
With Mail
.To = "XXXX.XXXX@XXX.com"
'.CC = ""
.Subject = "Auftragsliste " 'Betreff
.BodyFormat = 2 '2 = HTML, 1 = Text
.Attachments.Add strDatei 'Anhang
.Body = strBodyText 'Bodytext / Signatur
End With

'** Erzeugte Datei schließen
Workbooks(Dir(strDatei)).Close

'** Erzeugte Datei wieder löschen
Kill (strDatei)

'** E-Mail anzeigen
Mail.Display
Application.DisplayAlerts = True
End Sub

Gruß Andreas

 

Hi Andreas,

nach diesem Prinzip:

Code:

    Dim arrTabs()
    ReDim arrTabs(1 To 2)
    arrTabs(1) = ActiveSheet.Name
    arrTabs(2) = "Tabelle2"  '<== Name der 2. Tabelle anpassen
    Worksheets(arrTabs).Copy

Bis später,
Karin

 

Hallo Karin,
das war super duper...hat funktioniert.
Ganz vielen lieben Dank.

 

Hallo Karin,

ich probiere mich gerade an diesem Befehl. Jedoch scheine ich es nicht korrekt hinzubekommen. Wo muss ich deinen Befehl genau einsetzen und was muss ich entfernen. Einzelne Sheets oder die gesamte Datei ist nicht das Problem. Ich kriege es leider nicht mit dem Beispiel hin. Mein Befehl ist genauso wie im oberen Beispiel aufgebaut.

Vielen Dank im Voraus.

Mfg Flotinho

 

Hi,

sorry, ich verstehe leider absolut nicht was du meinst: wenn "einzelne Sheets oder die gesamte Datei" nicht das Problem ist - wo liegt das Problem dann?

Bis später,
Karin

 

Hallo Karin,

ich habe den u.a. Code benutzt um einzelne Tabellenblätter automatisch per Email (Outlook) zu versenden. Das klappt auch ganz gut. Auch das Versenden der gesamten Arbeitsmappe, habe ich hinbekommen und funktioniert einwandfrei. Nun möchte ich zwei bzw. mehrere ausgewählte Tabellenblätter automatisch versenden und bekomme es mit deinem Befehl leider nicht hin.

Dim arrTabs()
ReDim arrTabs(1 To 2)
arrTabs(1) = ActiveSheet.Name
arrTabs(2) = "Tabelle2" '<== Name der 2. Tabelle anpassen
Worksheets(arrTabs).Copy

An welcher Stelle muss ich deinen Befehl einpflegen bzw. was muss ich evtl. entfernen, damit dieser Befehl funktioniert? Ich nutze Office 2016.

Sub XXX_Schaltfläche9_Klicken()
Application.DisplayAlerts = False
'** Das aktive Tabellenblatt wird über Outlook versendet
'** Dimensionierung der Variablen
Dim strBlatt As String
Dim strDatei As String
Dim strPfad As String
Dim outObj As Object
Dim Mail As Object
Dim strBodyText As String
Set outObj = CreateObject("Outlook.Application")
Set Mail = outObj.CreateItem(0)
'** Pfad für temporäre Zwischenspeicherung angeben
strPfad = "C:\Temp" 'entsprechend anpassen
'** Aktuelles aktives Blatt in neue Arbeitsmappe kopieren
strBlatt = ActiveSheet.Name
'** Gewähltes Tabellenblatt kopieren
Sheets(strBlatt).Copy
'** Blatt temporär in vorgegebenes Verzeichnis abspeichern
ActiveWorkbook.SaveAs strPfad & "" & ActiveSheet.Name

'** Pfad und Dateiname der neuen Datei zwischenspeichern
strDatei = ActiveWorkbook.FullName

'** Body-Text festlegen
strBodyText = "Hallo Herr XXX." & vbCrLf & vbCrLf & "anbei die aktuelle Auftragsliste für das ..." & vbCrLf & vbCrLf & "Gruß ..."

'** Mail erzeugen
With Mail
.To = "XXXX.XXXX@XXX.com"
'.CC = ""
.Subject = "Auftragsliste " 'Betreff
.BodyFormat = 2 '2 = HTML, 1 = Text
.Attachments.Add strDatei 'Anhang
.Body = strBodyText 'Bodytext / Signatur
End With

'** Erzeugte Datei schließen
Workbooks(Dir(strDatei)).Close

'** Erzeugte Datei wieder löschen
Kill (strDatei)

'** E-Mail anzeigen
Mail.Display
Application.DisplayAlerts = True
End Sub

Vielen Dank im Voraus.

Gruß Flotinho

 

Hi,

anstelle der Codezeilen

Code:

'** Aktuelles aktives Blatt in neue Arbeitsmappe kopieren
strBlatt = ActiveSheet.Name
'** Gewähltes Tabellenblatt kopieren
Sheets(strBlatt).Copy

meinen Code.

Bis später,
Karin

 

Hallo Karin,

hatte es bereits gestern schon so eingefügt wie Du es beschrieben hast. Jedoch hatte es nicht funktioniert. Nachdem ich "Array" aber einmal ausgeschrieben hatte, klappt es nun! :)

Vielen Dank für Deine Unterstützung!

Gruß Flotinho