能否用Excel宏打开网页版Outlook并自动填充邮件字段及附加文件？

核心思路 #

网页版Outlook没有客户端那样的COM自动化接口，需通过VBA操控Edge浏览器模拟人工操作，完成邮件字段填充和附件上传。以下是适配需求的完整宏代码，整合原有PDF保存逻辑与网页版Outlook自动化流程。

完整宏代码 #

Sub AutoSendWebOutlookMail()
    Dim FileFullPath As String
    Dim TempFileName As String
    Dim ReportName As String
    Dim EdgePath As String
    Dim NewMailUrl As String
    Dim WaitTime As Integer
    
    ' --------------------------
    ' 1. 原有逻辑：保存工作表为PDF（按需调整）
    ' --------------------------
    ReportName = "收件人邮箱@xxx.com" ' 替换为实际收件人邮箱
    TempFileName = "邮件主题内容" ' 替换为实际邮件主题
    FileFullPath = ThisWorkbook.Path & "\" & TempFileName & ".pdf" ' PDF保存路径
    
    ' 导出当前工作表为PDF
    ActiveSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=FileFullPath, _
        Quality:=xlQualityStandard
    
    ' --------------------------
    ' 2. 配置Edge路径与共享邮箱新建邮件链接
    ' --------------------------
    EdgePath = "C:\Program Files (x86)\Microsoft\Edge\Application\msedge.exe" ' Edge默认安装路径，若安装位置不同请修改
    NewMailUrl = "https://outlook.office365.com/mail/new?mailboxid=共享邮箱地址@xxx.com" ' 替换为实际共享邮箱地址
    
    ' --------------------------
    ' 3. 打开Edge并跳转至新建邮件页面
    ' --------------------------
    Shell EdgePath & " " & Chr(34) & NewMailUrl & Chr(34), vbNormalFocus
    WaitTime = 10 ' 页面加载等待时间（秒），根据网络情况调整
    Application.Wait Now + TimeValue("00:00:" & WaitTime)
    
    ' --------------------------
    ' 4. 自动填充邮件字段（模拟键盘操作）
    ' --------------------------
    ' 填充收件人
    SendKeys ReportName & "{TAB}", True
    Application.Wait Now + TimeValue("00:00:01")
    
    ' 填充主题
    SendKeys TempFileName & "{TAB}", True
    Application.Wait Now + TimeValue("00:00:01")
    
    ' 如需填充正文，取消下面两行注释并修改内容
    ' SendKeys "邮件正文内容{TAB}", True
    ' Application.Wait Now + TimeValue("00:00:01")
    
    ' --------------------------
    ' 5. 自动附加PDF文件
    ' --------------------------
    ' 触发附件上传快捷键（Outlook网页版：Alt+N+A）
    SendKeys "%NA", True
    Application.Wait Now + TimeValue("00:00:02")
    
    ' 输入PDF路径并确认上传
    SendKeys FileFullPath, True
    Application.Wait Now + TimeValue("00:00:01")
    SendKeys "{ENTER}", True
    Application.Wait Now + TimeValue("00:00:02")
    
    ' 如需直接发送，取消下面一行注释；如需手动预览则保留注释
    ' SendKeys "%S", True
End Sub

关键注意事项 #

• Edge路径调整：若Edge安装在非默认路径，需修改EdgePath变量的值。
• 等待时间适配：WaitTime及各步骤后的等待时间需根据网络速度、电脑性能调整，确保页面加载完成后再执行后续操作。
• SendKeys局限性：该方法依赖窗口焦点与界面元素位置，若Outlook网页版界面更新或焦点丢失，可能导致操作失败。若需更稳定的方案，可结合Selenium VBA（需额外安装组件）直接操控网页DOM元素。
• 共享邮箱权限：确保当前登录账号拥有共享邮箱的发送权限，且Edge已保存共享邮箱的登录状态，避免每次操作需手动登录。

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