excel批量发给每个职工邮件.docx

EXCEL是科室日常工作数据处理的主要软件，如科室工作量、挂号、教学、退费、周末门诊等，最占用时间的主要有：多个文件（或工作表）的”智能”合并、按职工姓名拆分文件、批量发给每个职工邮件（带有不同的附件）等。

是不是想让软件帮助自动化实现呢？请看如下：

合并工作表/簿数据

二、按职工姓名拆分工作表为工作簿（类似工资条）

发带附件的邮件（基于outlook，不是outlookexpress）

合并工作表/簿数据：VLOOKUP函数

VLOOKUP函数=VLOOKUP(查找的值，查找区域，返回列的位置，查找的方式)

举例：=VLOOKUP(B2,[文件]工作表!:$A$1:$E$36,5,FALSE)

说明：查找区域可以是其他文件上的工作表。$表示绝对引用，以用于填充单元格

注：网上例子多多，

如

二、拆分一个工作表为多个文件，按某一列，一行一个文件，每个文件都带表头（类似工资条）

写一段VBA程序：

将工作表1第二行起每一行创建为一个新工作簿（独立文件），保留第一行的表头，工作簿以B列单元格值命名。（不超过200个职工），密码为bdkq,生成新的文件与源文件在同一个文件夹。（EXCEL中不能有空行）

Sub拆分()

DimiAsLong

DimnaAsString

Application.ScreenUpdating=False

Fori=2ToSheets(工作表1).Range(b200).End(xlUp).Row工作表名为：工作表1，最大200行，求是最大的行号，一行一个循环，第二行开始，第一行为标题

na=Sheets(工作表1).Cells(i,2).Value第二列为名字，保存文件时的文件名

Sheets(工作表1).Copy工作表1整体COPY，如果既不指定Before也不指定After，则将新建一个工作簿，其中包含复制的工作表。

ActiveWorkbook.SaveAsFilename:=ThisWorkbook.Path\na.xlsx,Password:=bdkq文件名，扩展名xlsx，口令

Rows(i).CopyRows(2)第i行，COPY到第2行

Rows(3:Range(b200).End(xlUp).Row).Delete第3行以下，删除

ActiveWindow.Closesavechanges:=True

Next

Application.ScreenUpdating=True

EndSub

三、批量发邮件（带相应的附件）

Alt+F11打开vba编辑器，然后在“工具”菜单中选择“引用”，并添加类似于“MicrosoftOutlook##.0ObjectLibrary”的引用，其中“##”是Outlook的版本号（如果我没有记错的话，2003是11.0，2007是12.0，2010是14.0—

Sheet1中，第2列为名字，第3列为email地址，第4列为提示用语，附件文件名为第2列的名字

Sub全自动发送邮件()

DimmyOlAppAsObject

DimmyitemAsObject

DimiAsInteger,jAsInteger

DimstrgAsString

DimattsAsObject

DimmyccAsObject

DimmyfileAsString

SetmyOlApp=CreateObject(Outlook.Application)创建outlook应用设置调用Outlook来发送邮件

设置对Sheet1工作表进行操作，数据保存于Sheet1中

WithSheets(Sheet1)

i=2第二行开始

DoWhile.Cells(i,2)第二列为KEY判断

Setmyitem=myOlApp.CreateItem(0)

Setatts=myitem.Attachments

收件人邮箱地址调用了第3列邮箱的数据

myitem.To=.Cells(i,3)

邮件标题调用了第2列姓名、第4列标题的数据

myitem.Subject=.Cells(i,2)老师，.