发送附带 Excel 的 Outlook 电子邮件，该 Excel 在收件人的特定选项卡中打开

Question

希望你一切都好。 我有一个 VBA 代码来生成电子邮件并在 Outlook 上附加了 Excel 工作簿。工作正常。该按钮位于 1 个选项卡上，我想确保当收件人打开工作簿时，它位于另一个特定选项卡上。即生成电子邮件的按钮位于选项卡 1 上，用户将打开选项卡 2。由于有多个选项卡，我不能只发送选项卡 2。 有人可以建议是否有一个简单的解决方案吗？ 谢谢你

我的代码：

Sub Rectangle1_Click()
Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Dim signature As String
    On Error Resume Next
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    
    With xOutMail
        .display
    End With

    signature = xOutMail.body

    
    xMailBody = "" & vbNewLine & vbNewLine & _
              "" & vbNewLine & _
              ""
                  On Error Resume Next
    With xOutMail
        .To = Range("T2")
        .CC = Range("U2")
        .BCC = ""
        .Importance = 2
        .Subject = Range("V2")
        .body = xMailBody & signature
        .Attachments.Add ActiveWorkbook.FullName
        .display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Answer 1

此代码将创建单词簿的临时副本并激活所需的选项卡，例如（sheet2），生成带有附件的电子邮件，然后在撰写电子邮件后从临时副本存储原始工作簿

Sub Rectangle1_Click()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Dim signature As String
    On Error Resume Next
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    On Error GoTo 0
    
    ' Copy the Excel workbook to a temporary file to preserve the original workbook's state
    ActiveWorkbook.SaveCopyAs "C:\Temp\TempWorkbook.xlsx"
    
    Dim targetTabName As String
    targetTabName = "Sheet2" ' Replace "Sheet2" with the name of your desired tab
    
    Worksheets(targetTabName).Activate
    
    With xOutMail
        .Display
    End With
    
    ' Restore the original workbook from the temporary file
    Application.DisplayAlerts = False ' Suppress alert for overwriting the original file
    ActiveWorkbook.Close SaveChanges:=False
    Kill ActiveWorkbook.FullName ' Delete the original workbook
    Name "C:\Temp\TempWorkbook.xlsx" As ActiveWorkbook.FullName 
    Application.DisplayAlerts = True 
    
    signature = xOutMail.Body
    xMailBody = "" & vbNewLine & vbNewLine & _
               "" & vbNewLine & _
               ""

    On Error Resume Next
    With xOutMail
        .To = Range("T2")
        .CC = Range("U2")
        .BCC = ""
        .Importance = 2
        .Subject = Range("V2")
        .Body = xMailBody & signature
        .Attachments.Add ActiveWorkbook.FullName
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Answer 2

您可以通过使用 Workbook_Open 事件激活您希望用户在打开工作簿时首先看到的工作表来实现此目的。每次打开工作簿时都会触发此事件。

您需要将此代码放入 VBA 编辑器的

ThisWorkbook

模块中。执行此操作的方法如下：

1. 按

   Alt + F11

   打开 VBA 编辑器。
2. 在左侧的项目资源管理器中，找到您的工作簿并双击

   ThisWorkbook

   。
3. 粘贴以下代码：

Private Sub Workbook_Open()
    Sheets("Sheet2").Activate
End Sub

将

"Sheet2"

替换为工作簿打开时要激活的工作表的名称。

请注意，这是工作簿的全局设置。每次打开工作簿时，无论如何打开，此代码都会运行并激活指定的工作表。

您的电子邮件发送代码可以保持不变。当收件人打开工作簿时，由于 Workbook_Open 事件，它将自动导航到指定的选项卡。

建议的 VBA 代码应放置在 VBA 编辑器中的

ThisWorkbook

对象内。该对象包含与工作簿本身相关的事件，例如打开、关闭工作簿或激活或停用工作簿时。

在本例中，我们使用

Workbook_Open

事件。顾名思义，每当打开工作簿时都会触发此事件。该事件内的代码将自动运行。打开工作簿时，行

Sheets("Sheet2").Activate

将使“Sheet2”成为活动工作表。

以下是在工作簿中添加

Workbook_Open

事件的步骤：

1. 在 Excel 中按

   Alt + F11

   打开 VBA 编辑器。
2. 在编辑器左侧的项目资源管理器中，找到您的工作簿。如果项目资源管理器不可见，您可以按

   Ctrl + R

   显示它。
3. 双击工作簿名称下的

   ThisWorkbook

   。这将打开一个与工作簿相关的新代码窗口。
4. 在新的代码窗口中，从左侧下拉菜单中选择“工作簿”，然后从窗口顶部的右侧下拉菜单中选择“打开”。
5. 这将自动创建一个

   Workbook_Open

   事件。在此活动中，写下

   Sheets("Sheet2").Activate

   。将“Sheet2”替换为您希望在工作簿打开时处于活动状态的工作表的名称。
6. 关闭 VBA 编辑器。

这是您修改后的VBA代码：

Sub Rectangle1_Click()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Dim signature As String

    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    
    With xOutMail
        .display
    End With

    signature = xOutMail.body

    xMailBody = "" & vbNewLine & vbNewLine & _
              "" & vbNewLine & _
              ""
    
    On Error Resume Next
    With xOutMail
        .To = Range("T2")
        .CC = Range("U2")
        .BCC = ""
        .Importance = 2
        .Subject = Range("V2")
        .body = xMailBody & signature
        .Attachments.Add ActiveWorkbook.FullName
        .display
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Private Sub Workbook_Open()
    Sheets("Sheet2").Activate
End Sub

使用此修改后的代码，当您运行

Rectangle1_Click

子例程时，它将发送带有工作簿作为附件的电子邮件。当收件人打开工作簿时，由于

Workbook_Open

事件，它将自动导航到指定的工作表。