VBA如何调用新版本的outlook应用发送邮件？

星梦月缘

老师好，VBA可以调用老版本的outlook应用程序进行批量发送邮件，但是现在默认的win11系统，配置了都是新版本的outlook邮箱应用程序，导致之前的VBA代码无法成功调用新的outlook应用进行批量发送邮件，请问老师有什么解决方案吗？


目前想到了一个笨的解决方法，就是把新版本的outlook应用强制给降到老的版本，但是感觉这个并不是长久之计，所以想问下老师，有没有方法调用新版本的outlook应用程序，

之前老版本的应用程序如下：

'使用　Outlook　来发送邮件了
Sub 群发邮件()
Dim aa
Dim mydir As String
                    aa = MsgBox("即将发送邮件，清检查发送信息，信息无误，请点“确认”继续", 1)
                    If aa = vbCancel Then
                        Exit Sub
                    End If
'Call wl
'Select Case Left(Cells(1, 6).Value, 8)
'Case GetText
'Case Else
'    aa = MsgBox("网络时间:" & GetText & Chr(13) & "数据时间:" & Left(Cells(1, 6).Value, 8) & Chr(13) & "正准备发送非常态日期数据，" & Chr(13) & "是否确认发送？", 1)
'    If aa = vbCancel Then
'         Exit Sub
'    End If
'    aa = MsgBox("网络时间:" & GetText & Chr(13) & "数据时间:" & Left(Cells(1, 6).Value, 8) & Chr(13) & "正准备发送非常态日期数据，" & Chr(13) & "请再次是否确认发送？", 1)
'    If aa = vbCancel Then
'         Exit Sub
'    End If
'End Select

                    aa = MsgBox("即将发送邮件，清检查发送信息，信息无误，请点“确认”继续" & VBA.Chr(13) & VBA.Chr(13) & Cells(1, 7).Value, 1)
                    If aa = vbCancel Then
                        Exit Sub
                    End If
        '要能正确发送并需要对Microseft　Outlook进行有效配置
        On Error Resume Next
        Dim a, endRowNo
        'Dim objOutlook As New Outlook.Application
        'Dim objMail As MailItem
         Dim objOutlook As Object
         Dim objMail As Object
        
        '取得当前工作表与Cells(1,1)相连的数据区行数
        endRowNo = Cells(1, 1).CurrentRegion.rows.Count
        '创建objOutlook为Outlook应用程序对象
        'Set objOutlook = New Outlook.Application
        Set objOutlook = CreateObject("Outlook.Application")
        '开始循环发送电子邮件，比如从第二行开始，第一行是标题
        For a = 2 To endRowNo
            mydir = Cells(a, 8).Value
            If mydir <> "" Then             '检查附件1，如果不存在，则不发送
                If FileFolderExists(mydir) Then
                    '创建objMail为一个邮件对象
                    'Set objMail = objOutlook.CreateItem(olMailItem)
                     Set objMail = objOutlook.CreateItem(0)
                        With objMail
                            .To = Cells(a, 3).Value         '设置收件人地址，如20017130@qq.com
                            .CC = Cells(a, 4).Value         '设置抄送收件人地址
                            .BCC = Cells(a, 5).Value        '设置密抄收件人地址
                            .Subject = Cells(a, 6).Value    '设置邮件主题
                            .Body = Cells(a, 7).Value       '邮件内容
                            .Attachments.Add Cells(a, 8).Value    '设置附件1，需包含路径
                            .Attachments.Add Cells(a, 9).Value
                            .Attachments.Add Cells(a, 10).Value
                            .Attachments.Add Cells(a, 11).Value
                            .Attachments.Add Cells(a, 12).Value
                            .Send
                         End With
                    '销毁objMail对象
                    Set objMail = Nothing
                Else
                    MsgBox "第" & a & "行，" & VBA.Chr(13) & mydir & VBA.Chr(13) & "文件不存在,邮件没有发送成功。"
                    Exit Sub
                End If
            Else
                MsgBox "第" & a & "行，附件路径为空,邮件没有发送成功。"
                Exit Sub
            End If
         ' Delay 3                  '延时几秒发数据，针对规定时间内发送邮件数量有限制的人使用
            
        Next
          '销毁objOutlook对象
          Set objOutlook = Nothing
         
       MsgBox "邮件已发送，稍候请留意查收！", 0, "发送回报"
         
End Sub

lss001

Outlook发送邮件前需要配置帐号
建议使用CDO稍微简单些仅需配置授权码
https://club.excelhome.net/forum.php?mod=viewthread&tid=1519101&extra=&mobile=2&_dsign=ce3f949f

星梦月缘

lss001 发表于 2024-10-13 13:40
Outlook发送邮件前需要配置帐号
建议使用CDO稍微简单些仅需配置授权码
https://club.excelhome.net/forum ...

好的 谢谢老师  但是对于小白来说  配置授权码还是挺麻烦的  而且不懂的人会感觉不安全。所以还是在想有没有办法直接调用新版本outlook邮箱

lss001

星梦月缘 发表于 2024-10-14 17:06
好的 谢谢老师  但是对于小白来说  配置授权码还是挺麻烦的  而且不懂的人会感觉不安全。所以还是在想有 ...

发送邮件前
新版本首先设置帐号
为避免发送失败
第一次发送先手动打开Outlook(new)
然后发送邮件