EXCEL:用于单个纸张的Attachments.Add

Question

我有一个代码，我一直在使用它，通过命令按钮单击自动发送电子邮件给工作簿。我试图重新格式化这段代码，以便从工作簿中发送两个单独的工作表(名为: Pass，PASScreen快照)，但我无法让它工作。当电子邮件发送时，纸张将不处于活动状态。这是我一直在使用的代码，任何帮助都将不胜感激：

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

Attachments.Add方法采用文件路径参数，无法重新配置该参数以发送工作表(或工作表数组)对象。您可以做的是将这两个表导出到一个新的/临时文件中，作为附件发送，然后删除/终止不再需要的临时文件。

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