如何使用VBA将已打开的Excel文件作为邮件附件发送？

当Excel文件处于打开状态时，直接通过文件路径添加附件会因文件锁定报错，以下是两种可行的解决办法：

方法1：使用当前工作簿的完整路径（需文件已保存） #

如果文件已经保存过，直接调用ThisWorkbook.FullName获取文件路径，Outlook可以正常附加处于打开状态的文件。修改后的代码如下：

Sub SendOpenWorkbookAsAttachment()
    Dim OutApp As Object, MailItem As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set MailItem = OutApp.CreateItem(0) ' 创建邮件
    
    ' 确保文件已保存，否则ThisWorkbook.FullName为空
    If ThisWorkbook.Path = "" Then
        MsgBox "请先保存当前文件再执行此宏！", vbExclamation
        Exit Sub
    End If
    
    With MailItem
        .To = "recipient@example.com"
        .Subject = "测试邮件：已打开的Excel文件附件"
        .Body = "这是已打开的Excel文件作为附件的测试邮件。"
        .Attachments.Add ThisWorkbook.FullName ' 使用当前工作簿的完整路径
        .Send ' 直接发送，如需预览可改为.Display
    End With
    
    Set MailItem = Nothing
    Set OutApp = Nothing
End Sub

方法2：保存为临时文件发送（适用于未保存的新建文件） #

如果文件是新建未保存的，或者不想使用原文件路径，可以先将文件另存为临时文件，发送后再删除临时文件：

Sub SendTempWorkbookAsAttachment()
    Dim OutApp As Object, MailItem As Object
    Dim tempPath As String
    
    Set OutApp = CreateObject("Outlook.Application")
    Set MailItem = OutApp.CreateItem(0)
    
    ' 生成临时文件路径
    tempPath = Environ("TEMP") & "\" & ThisWorkbook.Name
    ThisWorkbook.SaveCopyAs tempPath ' 保存副本到临时目录
    
    With MailItem
        .To = "recipient@example.com"
        .Subject = "测试邮件：临时文件附件"
        .Body = "这是通过临时文件发送的已打开Excel文件。"
        .Attachments.Add tempPath
        .Send
    End With
    
    ' 删除临时文件
    Kill tempPath
    
    Set MailItem = Nothing
    Set OutApp = Nothing
End Sub

内容的提问来源于stack exchange，提问作者kxmoosekx