使用VBA实现发邮件功能

财务MM经常要给员工发送每月的工资信息，一个个发送实在是太忙了。本文将介绍使用VBA实现工资信息的自动发送。有了这个功能，财务MM只需要把基本数据准备好，然后按下按钮只要选择需要发送的对象。就可以快速将邮件发送出去，有没有一种火箭发射的感觉。再也不用一个个拷贝发送了。可以喝喝茶，化化妆，聊聊天。很不是很赞呢？

功能设计思路

设计以下3个sheet页

因为需要发邮件，为了保证程序的可扩展性。用户可以自己配置SMTPServer、用户名密码相关的信息

工资信息sheet页存放工资信息

邮件发送程序是最关键的部分，用户切换到邮件发送程序的时候。会自动启动发送程序。根据工资信息表中的邮箱信息给员工发送相应的工资信息

程序设计思路

1.核心功能->发送邮件

本程序采用微软的CDO组件来实现发送，因此在使用之前需要导入这个组件，方法参见下图。本功能以附件的形式发送工资信息

‘最核心的邮件发送程序

'主要的入口参数是：邮件的接收方   邮件的标题、正文、以及附件所在路径

'在发送邮件的逻辑中一定要调用获取配置的函数以获取到配置信息。

Sub MailSend(mail As String, subject As String, body As String, attachmentpath As String )

’这里定义CDO对象。只有定义了才能正确调用邮件发送功能哦

Dim cm As New CDO.Message

Dim cfg As MailCfg

cfg = getmailcfg()

'这里用于设置邮件的收件人、发件人、标题、正文、附件信息、抄送对象、密送对象

cfg = getmailcfg()

cm.From = cfg.username

cm.To = mail

cm.subject = subject

cm.BodyPart = body

‘这段代码是给发送程序配置服务器、端口、用户名、密码等信息

stUl = 'http://schemas.microsoft.com/cdo/configuration/'

With cm.Configuration.Fields

    .Item(stUl & 'smtpserver') = cfg.server

    .Item(stUl & 'smtpserverport') = cfg.serverport

    .Item(stUl & 'sendusing') = cfg.localport

    .Item(stUl & 'smtpauthenticate') = cfg.auth

    .Item(stUl & 'sendusername') = cfg.username

    .Item(stUl & 'sendpassword') = cfg.userpwd

    .Update '更新配置

End With

cm.Send  ’调用发送功能

Set cm = Nothing  '记住一定要释放

End Sub

2.配套功能->读取服务器、账号配置用于发邮件

’ 定义Mailcfg结构用于存储邮件发送需要的配置信息

Type MailCfg

server As String

serverport As String

localport As String

auth As String

username As String

userpwd As String

sendmail As String

End Type

'该函数用来从邮件配置信息 sheet获取发送所需要的配置信息

'为了方便管理，将其放在MailCfg 结构中。供发送程序使用

Function getmailcfg() As MailCfg

Dim cfg As MailCfg

Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets('邮件配置信息')

cfg.server = ws.Cells(1, 2)

cfg.serverport = ws.Cells(2, 2)

cfg.localport = ws.Cells(3, 2)

cfg.auth = ws.Cells(4, 2)

cfg.username = ws.Cells(5, 2)

cfg.userpwd = ws.Cells(6, 2)

cfg.sendmail = ws.Cells(7, 2)

getmailcfg = cfg

End Function

3.业务功能->读取工资信息 生成临时文件&调用发送程序

sub SalaryMailSend()

dim ws as worksheet

dim subject as string

dim body as string

dim attachmentpath  as string

dim empname as string

dim smonth as string

dim wb as workbook

set ws = thisworkbook.sheets('工资信息')

‘遍历所有的行

for i = 2 to ws.usedrange.rows.count

empname =  ws.cells(i,1)

smonth = ws.cells(i,2)

'每个员工生成一个附件

set wb = workbooks.Add

wb.name = empname &  smonth&'工资.xls'

....

’设置正文、标题

body = ' 附件是' & empname &  ' '& smonth  &'月份的工资信息'

subject = '工资信息，请查收'

‘ 附件放在当前目录下 文件名为 员工的姓名 月份

attachmentpath = wb.fullname

'调用发送逻辑

call MailSend(ws.cells(i,3),subject,boday,attachmentpath)

next i

end sub

本文主要介绍了使用VBA发送邮件的功能，大家可以考虑。本程序的设计有没有不合理的地方。欢迎大家指出