Access开发邮件发送功能（access开发文档） - 技术教程

Hi，大家好！

暑假开始了，不知道各位都有什么精彩的暑期安排呢？或许可以抽出一些时间来学习 Access！嘿嘿！

我们已经讲了好几篇的outlook的文章了，每次的应用都是围绕着outlook的来实现一些邮件的操作，那今天我们就给大家分享邮件发送功能，废话不多说，让我们开干！

再次提醒大家，这次干货满满，开始前先给个一键三连吧！

创建窗体

这次我们创建的窗体控件比较多，具体如下：

控件	控件名称
文本框（收件人）	txtTo
文本框（抄送）	txtCC
文本框（密抄）	txtBCC
文件框（标题）	txtSubject
文本框（附件）	txtPath
文本框（内容）	txtBody
按钮（发送）	btnSend
按钮（浏览）	btnBrowse

添加代码

这里代码要分好几块，大家依次复制添加

添加一下枚举类型

Option Explicit

' 邮件格式常量枚举，用于指定邮件正文格式
Public Enum EmailFormatEnum
dpEmailFormatText = 0 ' 纯文本格式
dpEmailFormatHTML = 1 ' HTML 网页格式
dpEmailFormatURL = 2 ' 超链接格式（邮件内容是一个网页地址，自动获取并发送网页内容）
End Enum

添加发送邮件函数，注意要替换你自己的配置，这里代码我都写死了，大家也可以自己做一个配置功能！

' 发送邮件函数：通过 CDO 对象配置 SMTP 参数并发送邮件
Public Function SendEmail(ToAddress As String, _
Subject As String, _
Body As String, _
Optional Attachment As String, _
Optional CC As String, _
Optional BCC As String, _
Optional BodyFormat As EmailFormatEnum = dpEmailFormatText _
) As Boolean
On Error GoTo ErrorHandler

Dim strNameSpace As String
Dim objMessage As Object ' CDO.Message
Dim cdoConfig As Object
Dim SendUserName As String

SendEmail = False
SendUserName = "你的邮箱地址" ' 发件人邮箱

' 创建 CDO 对象以进行邮件发送
Set objMessage = CreateObject("CDO.Message")
Set cdoConfig = CreateObject("CDO.Configuration")

' 设置 CDO 配置项，如 SMTP 服务器、端口、凭证等
strNameSpace = "http://schemas.microsoft.com/cdo/configuration/"
With cdoConfig.fields
.Item(strNameSpace & "smtpserver") = "你的发送服务器"
.Item(strNameSpace & "smtpserverport") = 25
.Item(strNameSpace & "sendusing") = 2
.Item(strNameSpace & "smtpauthenticate") = 1
.Item(strNameSpace & "smtpusessl") = False
.Item(strNameSpace & "sendusername") = SendUserName
.Item(strNameSpace & "sendpassword") = "你的密码"
.Update
End With

' 根据不同正文格式设置邮件内容，并发送
With objMessage
Set .Configuration = cdoConfig
.From = SendUserName
.To = ToAddress
.CC = CC
.BCC = BCC
.Subject = Subject
.BodyPart.Charset = "UTF-8"

Select Case BodyFormat
Case dpEmailFormatHTML
.HTMLBody = Body
Case dpEmailFormatURL
.CreateMHTMLBody Body
Case Else
.TextBody = Body
End Select

' 若有附件，则添加附件
.AddAttachment Me.txtPath

.fields.Update
.Send
End With

SendEmail = True

ExitHere:
' 释放对象
Set cdoConfig = Nothing
Set objMessage = Nothing
Exit Function

ErrorHandler:
' 错误处理，显示错误信息
MsgBox "#" & Err.Number & " SendEmail()" & vbCrLf & Err.Description, vbCritical
Resume ExitHere
End Function

发送按钮的单击事件

' 发送按钮：调用 SendEmail 函数发送邮件，并根据返回值弹窗提示
Private Sub btnSend_Click()
If SendEmail(Me.txtTo, Me.txtSubject, Nz(Me.txtPath, ""), Nz(Me.txtCC, ""), Nz(Me.txtBCC, "")) Then
MsgBox "发送成功", vbInformation
Else
MsgBox "失败", vbInformation
End If
End Sub

浏览按钮的单击事件

' 浏览按钮：打开文件选择对话框，获取单个文件路径并赋值给文本框
Private Sub btnBrowse_Click()
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Clear
.AllowMultiSelect = False
.InitialFileName = ""
If Not .Show Then
Exit Sub
End If
Me.txtPath = .SelectedItems(1)
End With
End Sub

运行测试

代码添加好了，最后，就是运行测试了，这里我还是给大家截个图，亲测，代码肯定是可以的，大家自己在测试时，一定要仔细，还有注意了，部分邮箱（如QQ邮箱）要求必须使用SSI加密。端口也是需要修改的，我这里输入的是25。

好了，今天的分享就到这里了，这么好用的功能，大家快去试一下吧，原创文章不容易，大家给个三连吧！谢谢大家了！

#access#