jerry0110
Erfahrenes Mitglied
Hallo zusammen,
ich habe folgenden Code gefunden und angepasst. Der Code war für einen Anhang gedacht und ich habe diesen jetzt abgeändert nach meinem Verständnis um eine 2te Datei anzuhängen. Es muss leider eine 2te Datei sind und nicht eine Datei mit den 2 ausgewählten Sheets.
Natürlich funktioniert es nicht. Bei einem Anhang funktioniert es ohne Probleme.
Habe zwar noch eine If Schleif drin:
Aber die verhindert ja nur, wenn die Tabelle nicht gefüllt ist, dass er keine Email erzeugt.
ich habe folgenden Code gefunden und angepasst. Der Code war für einen Anhang gedacht und ich habe diesen jetzt abgeändert nach meinem Verständnis um eine 2te Datei anzuhängen. Es muss leider eine 2te Datei sind und nicht eine Datei mit den 2 ausgewählten Sheets.
Visual Basic:
Sub EMail()
Dim strBlatt As String
Dim strDatei As String
Dim strPfad As String
Dim outObj As Object
Dim Mail As Object
Dim strBlatt2 As String
Dim strDatei2 As String
Dim strBodyText As String
Dim strPfad2 As String
Dim myDate As Date
myDate = datum
ThisWorkbook.Worksheets("Ja").Activate
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 & "\" & Format(myDate, "DD.MM.YYYY") & "_Ja.xls"
'** Pfad und Dateiname der neuen Datei zwischenspeichern
strDatei = strPfad & "\" & Format(myDate, "DD.MM.YYYY") & "_Ja.xls"
ThisWorkbook.Worksheets("Gesamt").Activate
'** Aktuelles aktives Blatt in neue Arbeitsmappe kopieren
strBlatt2 = ActiveSheet.Name
'** Gewähltes Tabellenblatt kopieren
Sheets(strBlatt2).Copy
'** Blatt temporär in vorgegebenes Verzeichnis abspeichern
ActiveWorkbook.SaveAs strPfad2 & "\" & Format(myDate, "DD.MM.YYYY") & "_Gesamt.xls"
'** Pfad und Dateiname der neuen Datei zwischenspeichern
strDatei2 = strPfad2 & "\" & Format(myDate, "DD.MM.YYYY") & "_Gesamt.xls"
'** Body-Text festlegen
strBodyText =
'** Mail erzeugen
With Mail
.SentOnBehalfOfName = ""
.To = ""
.CC = ""
.Subject = "" 'Betreff
.BodyFormat = 1 '2 = HTML, 1 = Text
.Attachments.Add strDatei & strDatei2 'Anhang
.Body = strBodyText 'Bodytext / Signatur
End With
'** Erzeugte Datei schließen
Workbooks(Dir(strDatei)).Close
Workbooks(Dir(strDatei2)).Close
'** Erzeugte Datei wieder löschen
Kill (strDatei)
Kill (strDatei2)
'** E-Mail anzeigen
Mail.Display
End Sub
Natürlich funktioniert es nicht. Bei einem Anhang funktioniert es ohne Probleme.
Habe zwar noch eine If Schleif drin:
Visual Basic:
If ThisWorkbook.Sheets("Gesamt").Range("C2").Text = "" Then Exit Sub
Aber die verhindert ja nur, wenn die Tabelle nicht gefüllt ist, dass er keine Email erzeugt.
Zuletzt bearbeitet von einem Moderator: