VBA 怎么用公邮发送邮件（OutLook）

永是晖的人 · 发表于 2022-2-21 16:00

各位大神，有没有人可以做出来的

Sub SendEmail()
'要能正确发送并需要对Microseft Outlook进行有效配置
Dim OutlookApp As New Outlook.Application '要正常运行这句,要将工具/引用中的Microseft Outlook *.0 Object Library(其中*为你Microseft Outlook的版本号)选上
Dim OutlookItem As MailItem
Set OutlookApp = New Outlook.Application
Dim sht As Worksheet
Dim rng As Range
Set sht = ThisWorkbook.Worksheets(1)
For Each rng In Intersect(sht.Range("a2:a10000"), sht.UsedRange) '开始循环发送电子邮件
Set OutlookItem = OutlookApp.CreateItem(0) '创建objOutlook为Outlook应用程序对象
Receiver = rng.Value '获取TO的值
ReceiverCC = rng.Offset(0, 1).Value '获取CC的值
SubjectText = rng.Offset(0, 2).Value '获取主题的值
BodyText = rng.Offset(0, 3).Value '获取正文的值
AttachedObject = rng.Offset(0, 4).Value '获取正文图片的值
'插入图片的格式
htm = "<html><img src='cid:测试图片.png' height=500 width=700> " & _
" ★ " & _
"<a href = 'https://www.baidu.com/'>MyJob</a>" & _
" ★ " & _
"<a href = 'https://www.baidu.com/'>MyPlan</a>" & _
" ★ " & _
"<a href = 'https://www.baidu.com/'>Skills</a>" & _
" ★ " & _
"<a href = 'https://www.baidu.com/'>CV</a>" & _
" ★"
With OutlookItem
OutlookItem.SentOnBehalfOfName = "XXXXXXXXXX" '发送人地址
.To = Receiver '设置TO地址
.CC = ReceiverCC '设置CC地址
.Subject = SubjectText '设置主题地址
.HTMLBody = BodyText & htm '设置邮件内容
If AttachedObject <> "" Then
.Attachments.Add ThisWorkbook.Path & "" & AttachedObject
End If
'.Display '预览邮件
.Send '发送邮件
End With
Set OutlookItem = Nothing '销毁OutlookItem对象
Next
MsgBox ("Email sent successfully!")
End Sub

复制代码

永是晖的人 · 发表于 2022-2-21 16:02

附件在这儿

永是晖的人 · 发表于 2022-2-21 16:03

参考代码我放这儿了
欢迎各位大神交流，有什么更好的方法呢

永是晖的人 · 发表于 2022-2-21 16:16

发件人可以设置代表公邮来发送邮件，但公邮里没有记录发送邮件
公邮里怎样才能记录发送邮件

游乐缘 · 发表于 2022-2-22 08:52

OutlookItem.SentOnBehalfOfName貌似只设置了发件人地址，并没有切换到公邮账户，所以发送记录不在公邮下面。
可以试试换成OutlookApp.SendUsingAccount = OutlookApp.Session.Accounts("你使用的公邮账户名称")
下面的代码可以列出账户名单，以便使用SendUsingAccount方法

Sub ListAccountNames()
Dim ol As Outlook.Application
Dim ac As Outlook.Account
Set ol = New Outlook.Application
For Each ac In ol.Session.Accounts
Debug.Print ac.DisplayName
Next
End Sub

复制代码

永是晖的人 · 发表于 2022-2-22 15:34

游乐缘发表于 2022-2-22 08:52
OutlookItem.SentOnBehalfOfName貌似只设置了发件人地址，并没有切换到公邮账户，所以发送记录不在公邮下面 ...

我刚试了下，还是不行呀，不知道我是不是写错代码了

永是晖的人 · 发表于 2022-2-22 16:06

游乐缘发表于 2022-2-22 08:52
OutlookItem.SentOnBehalfOfName貌似只设置了发件人地址，并没有切换到公邮账户，所以发送记录不在公邮下面 ...

我这儿版本是Outlook 365

游乐缘 · 发表于 2022-2-22 23:45

永是晖的人发表于 2022-2-22 16:06
我这儿版本是Outlook 365

报错了吗？出现的问题具体是什么？

永是晖的人 · 发表于 2022-2-23 16:06

本帖最后由永是晖的人于 2022-2-23 16:11 编辑

游乐缘发表于 2022-2-22 23:45
报错了吗？出现的问题具体是什么？

C:\Users\xu.a.dong\OneDrive - Accenture\桌面\Snipaste_2022-02-23_16-05-16.png

游乐缘 · 发表于 2022-2-23 16:30

永是晖的人发表于 2022-2-23 16:06

先用Sub ListAccountNames在立即窗口查看输出的全部账户名称，然后作为OutlookApp.Session.Accounts("账户名称")的参数，截图中看到参数用的是邮箱地址。
也许是OutlookApp.Session.Accounts("MyOps.Productivity")，取决于账户名称

		自动登录	找回密码
密码			免费注册

[求助] VBA 怎么用公邮发送邮件（OutLook）