ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 2807|回复: 9

[求助] CDO发送邮件后excel就卡死了

[复制链接]

TA的精华主题

TA的得分主题

发表于 2016-5-26 10:02 | 显示全部楼层 |阅读模式
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 ivrdachen 于 2016-5-26 10:12 编辑

邮件可以发送成功,但是运行完之后,excel就无法正常编辑了,比如输入内容,需要双击其他单元格才输入的内容才会显示出来,删除内容也是一样,另外运行完这个代码后再转到其他应用窗口,就无法再回到excel窗口了,只能强行关闭重启才可以。不知道是运行了什么造成的
参照以下代码改的:
Sub CDOSENDEMAIL()
Dim CDOMail As Variant
On Error Resume Next '出错后继续执行
Application.DisplayAlerts = False '禁用系统提示
ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly '将工作簿设置为只读模式
Set CDOMail = CreateObject("CDO.Message") '创建对象
CDOMail.From = "10000@qq.com" '设置发信人的邮箱
CDOMail.To = "10000@qq.com" '设置收信人的邮箱
CDOMail.Subject = "主题:用CDO发送邮件试验" '设定邮件的主题
'CDOMail.TextBody = "文本内容" '使用文本格式发送邮件
CDOMail.HtmlBody = "当您看到此封邮件,表明CDO设置正确" '使用Html格式发送邮件
CDOMail.AddAttachment ThisWorkbook.FullName '发送本工作簿为附件
STUl = "http://schemas.microsoft.com/cdo/configuration/" '微软服务器网址
With CDOMail.Configuration.Fields
.Item(STUl & "smtpserver") = "smtp.qq.com" 'SMTP服务器地址
.Item(STUl & "smtpserverport") = 25 'SMTP服务器端口
.Item(STUl & "sendusing") = 2 '发送端口
.Item(STUl & "smtpauthenticate") = 1 '远程服务器需要验证
.Item(STUl & "sendusername") = "10000" '发送方邮箱名称
.Item(STUl & "sendpassword") = "password" '发送方邮箱密码
.Item(STUl & "smtpconnectiontimeout") = 60 '连接超时(秒)
.Update
End With
CDOMail.Send '执行发送
Set CDOMail = Nothing '发送成功后即时释放对象
If Err.Number = 0 Then
MsgBox "成功发送邮件", , "温馨提示" '如果没有出错,则提示发送成功
Else
MsgBox Err.Description, vbInformation, "邮件发送失败" '如果出错,则提示错误类型和错误代码
End If
ThisWorkbook.ChangeFileAccess Mode:=xlReadWrite '将工作簿设置为读写模式
Application.DisplayAlerts = True '恢复系统提示
End Sub

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-5-26 17:29 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
有大侠知道吗?

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-5-27 08:49 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-6-7 16:38 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
没有人知道吗?

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-6-13 11:19 | 显示全部楼层
找了一个笨办法解决了,貌似只要程序一结束就会卡住,没结束的话就不会,所以我在末尾加了个延时函数,果然可以
For i = 1 To 10000
t = DateAdd("s", 300, Now)
Do Until Now > t
DoEvents
Loop
Next

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-6-27 11:20 | 显示全部楼层
新的问题又来了,采用上面的方法虽然不卡了,但是查找功能也用不了了,唉

TA的精华主题

TA的得分主题

发表于 2018-7-31 20:13 | 显示全部楼层
ivrdachen 发表于 2016-6-27 11:20
新的问题又来了,采用上面的方法虽然不卡了,但是查找功能也用不了了,唉


我也遇到了同样的问题,本来想直接在工作表里添加一个过程,想不到一发完就卡。
后来试了一下新建一个窗体,把通过CDO发送邮件的代码添加到窗体里,卡顿的情况不存在了。
测试了一下,加入延时函数后会有些许改善,但是最终Excel界面还是会卡,所以建议你新建一个用户窗体试试。


邮件发送窗体.png

TA的精华主题

TA的得分主题

发表于 2019-6-14 17:24 | 显示全部楼层
sunya_0529 发表于 2018-7-31 20:13
我也遇到了同样的问题,本来想直接在工作表里添加一个过程,想不到一发完就卡。
后来试了一下新建一个 ...

能把你的窗体和代码发一份吗?不胜感谢!!!

TA的精华主题

TA的得分主题

发表于 2019-6-14 17:54 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2022-4-7 10:27 来自手机 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
sunya_0529 发表于 2018-7-31 20:13
我也遇到了同样的问题,本来想直接在工作表里添加一个过程,想不到一发完就卡。
后来试了一下新建一个 ...

会计,有这个想法,能否分享一下,
he-de-jiang@163.com
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 07:28 , Processed in 0.059060 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表