新PC运行Excel VBA发邮件脚本无法复制区域粘贴图片问题求助

这个故障和新旧设备的配置、Office选项设置无关，是新版Microsoft 365/2021 Office的安全机制更新，和原有代码的执行逻辑不兼容导致的：

• 旧版Office中Application.Dialogs(xlDialogSendMail).Show是非严格阻塞调用，唤起发信窗口后VBA会继续向下执行复制指令，且当时Outlook没有发信前锁定Excel进程、接管剪贴板的安全校验，所以脚本可以正常运行。
• 新版Office对这个内置发信接口做了两处改动：一是该接口变为严格模态调用，代码运行到这一行会直接挂起，直到手动关闭弹出的邮件窗口才会执行后续的复制操作；二是Outlook唤起发信窗口时会提前锁定Excel COM对象、接管剪贴板，阻断后续进程对剪贴板的写入操作，直接导致指定区域内容无法被复制到剪贴板。

两个方案可直接选用，优先选改动最小的方案1，追求长期稳定选方案2。

方案1：调整代码顺序（改动量最小） #

把区域复制操作移到唤起发信窗口之前，增加短等待时间确保内容完全写入剪贴板，避免被Outlook的安全锁清空，修改后完整代码：

Sub SendEmail()
    Dim ws As Worksheet
    Dim wb As Workbook

    Set wb = ActiveWorkbook
    Set ws = wb.Sheets("Daily Cash")

    ' 先复制指定区域，再调出发信窗口
    ws.Range("B2:H18").Copy
    ' 等待1秒确保内容完整写入剪贴板，适配新版Office的剪贴板校验逻辑
    Application.Wait Now + TimeValue("0:00:01")

    Application.Dialogs(xlDialogSendMail).Show

    ' 释放对象、清空剪贴板状态
    Set ws = Nothing
    Set wb = Nothing
    Application.CutCopyMode = False
End Sub

如果部分设备粘贴时仍出现图片丢失，把等待时长从1秒调整为2秒即可，不同设备的剪贴板响应速度存在差异。

方案2：直接调用Outlook对象生成邮件（长期兼容性最优） #

如果方案1受组策略、安全软件限制仍无法正常使用，可以弃用兼容性差的内置xlDialogSendMail接口，直接通过VBA调用Outlook客户端构建邮件，全程逻辑可控，不受Office版本更新影响，完整代码：

Sub SendEmail()
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim olApp As Object
    Dim olMail As Object
    Dim tempClip As Object
    Dim tempImgPath As String
    
    Set wb = ActiveWorkbook
    Set ws = wb.Sheets("Daily Cash")
    
    ' 把指定区域导出为临时图片，绕开剪贴板锁定问题
    tempImgPath = Environ("temp") & "\daily_cash_rpt.png"
    ws.Range("B2:H18").CopyPicture xlScreen, xlBitmap
    Set tempClip = CreateObject("Forms.Image.1")
    tempClip.Width = ws.Range("B2:H18").Width
    tempClip.Height = ws.Range("B2:H18").Height
    tempClip.Picture = Clipboard.GetData
    SavePicture tempClip.Picture, tempImgPath
    
    ' 唤起Outlook创建新邮件
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If olApp Is Nothing Then Set olApp = CreateObject("Outlook.Application")
    On Error GoTo 0
    
    Set olMail = olApp.CreateItem(0)
    With olMail
        .Subject = Replace(wb.Name, ".xlsx", "") & " 每日现金流报表" ' 可按需修改邮件主题
        .Attachments.Add wb.FullName ' 自动添加当前工作簿为附件
        .Attachments.Add tempImgPath, 1, 0
        ' 图片直接插入正文，不需要手动粘贴
        .HTMLBody = "<img src='cid:daily_cash_rpt.png' width='650'><br>"
        .Display ' 唤起邮件编辑窗口，如需直接发送可替换为 .Send
    End With
    
    ' 清理临时文件、释放对象
    Kill tempImgPath
    Set olMail = Nothing
    Set olApp = Nothing
    Set tempClip = Nothing
    Set ws = Nothing
    Set wb = Nothing
    Application.CutCopyMode = False
End Sub

这个方案不依赖剪贴板临时存储，直接将报表区域导出为图片插入邮件正文，后续Office更新安全策略也不会出现粘贴失败的问题，还支持自定义收件人、抄送、正文格式，灵活性远高于原有的内置发信接口。

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