EXCEL: Attachments.Add für einzelne Blätter

Question

Ich habe einen Code, den ich für immer verwendet habe, um automatisch eine Arbeitsmappe per Befehlsbutton per E-Mail zu senden. Ich habe versucht, diesen Code neu zu formatieren, um 2 einzelne Blätter (benannt: Pass, Pass Screenshot) aus der Arbeitsmappe zu senden, aber ich kann es nicht zum Laufen bringen. Die Blätter sind nicht aktiv, wenn die E-Mail gesendet wird. Dies ist der Code, den ich verwendet habe, wäre jede Hilfe sehr geschätzt werden:

Sub SendEmail() 
ThisWorkbook.Save 
Dim OutApp As Object 
Dim OutMail As Object 


Set OutApp = CreateObject("Outlook.Application") 
Set OutMail = OutApp.CreateItem(0) 

On Error Resume Next 
With OutMail 
.to = "my email" 
.Subject = "my subject" & Date 
.Attachments.Add '??? 

.Display 
End With 
On Error GoTo 0 

Set OutMail = Nothing 
Set OutApp = Nothing 
End Sub 

Answer 1

Die Attachments.Add Methode nimmt einen Argument Dateipfad, können Sie nicht, dass rekonfigurieren ein Arbeitsblatt (oder ein Array von Arbeitsblatt) Objekt senden . Sie können diese beiden Blätter in eine neue/temporäre Datei exportieren, als Anhang senden und dann die temporäre Datei, die nicht mehr benötigt wird, entfernen/löschen.

Sub SendEmail() 

Dim OutApp As Object 
Dim OutMail As Object 
Dim tempWB as Workbook 
Dim tempFile as String 
Dim wb as Workbook 

tempFile = Environ("Temp") & "\sheets_copy.xlsx" 

Set wb = ThisWorkbook 
wb.Save 
' The Sheets.Copy method will create a new workbook containing the copied sheets 
wb.Sheets(Array("Pass", "Pass Screenshot")).Copy 
Set tempWB = ActiveWorkbook 

' ensure no temp wb already exists 
' this can technically still fail if the file is open/locked 
If Len(Dir(tempFile)) <> 0 Then 
    Kill tempFile 
End If 
' Save & close the tempFile 
tempWB.SaveAs tempFile 
tempWB.Close 

Set OutApp = CreateObject("Outlook.Application") 
Set OutMail = OutApp.CreateItem(0) 

On Error Resume Next 
With OutMail 
.to = "my email" 
.Subject = "my subject" & Date 
.Attachments.Add tempFile '## Add your attachment here 
.Display 
End With 
On Error GoTo 0 

Set OutMail = Nothing 
Set OutApp = Nothing 
End Sub