注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

奕克

爱家人爱工作爱生活

 
 
 

日志

 
 

使用VBA自动批量发送隐私excel数据邮件  

2012-04-27 11:21:08|  分类: office |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
       这学期上的office编程课,陆陆续续讲了几个例子,后来想想最后把它们串起来,成为一个工作实例更有教学意义,就完善了一下。
       面对的情景是这样的,比如有如下一个excel数据表。通常目前单位的人员都是这么做的,把这个表邮件群发给大家,各自再用筛选过滤,但对于一些隐私性数据,比如个人的工资详单,就不能这样的,那么该咋办呢?

 

图片


     步骤一:分类生成独立工作表

     假设要处理的工作表是第一个并且唯一一个工作表,下面的excelvba代码能够根据第一列的数据分类生成每类的独立工作表,表名为第一列的类名。

Sub split1()

Application.DisplayAlerts = False

Set work = Worksheets(1)

Set temp = Worksheets.Add

y = 1

For i = 2 To work.UsedRange.Rows.Count

   work.Rows(i).Copy

   found = False

   For j = 1 To temp.UsedRange.Rows.Count

      If temp.Cells(j, 1).Value = work.Cells(i, 1).Value Then

         found = True

         foundname = temp.Cells(j, 1).Value

      End If

   Next

      If found Then

          k = Worksheets(foundname).UsedRange.Rows.Count + 1

          Worksheets(foundname).Rows(k).PasteSpecial

        Else

             Set ws = Worksheets.Add

             ws.Name = work.Cells(i, 1).Value

             ws.Rows(2).PasteSpecial

             work.Rows(1).Copy

             ws.Rows(1).PasteSpecial

             temp.Cells(y, 1).Value = work.Cells(i, 1).Value

             y = y + 1

             Set ws = Nothing

        End If

Next

temp.Delete

Application.DisplayAlerts = True

Set temp = Nothing

Set work = Nothing

End Sub


     分割后的工作簿如下图:

     

图片

 

   第二步:分离生成独立工作簿

    在把上述工作簿的那个原始数据工作表sheet1删除掉后,执行下面的excelvba代码,能为每个工作表生成一个工作簿,文件名为表名。


Sub split2()

Application.SheetsInNewWorkbook = 1

Application.DisplayAlerts = False

For Each x In ThisWorkbook.Worksheets

   Set temp = Workbooks.Add

   x.Copy after:=temp.Worksheets(temp.Worksheets.Count)

   temp.Worksheets(1).Delete

   temp.SaveAs Filename:=ThisWorkbook.Path & "\" & x.Name & ".xls"

   temp.Close

   Set temp = Nothing

Next

Application.DisplayAlerts = True

End Sub

    执行后文件夹内文件如下图:
     

图片

 

    第三步:群发邮件
    最后一步就是群发邮件了,网上现有一些代码都是直接在其他宿主程序中调用outlook发送,由于微软有安全性限制,每发送一封邮件,必须手动确定一个安全警告框,虽然有模拟鼠标的做法,但必须等待5秒。所以不方便,但是如果是在outlookvba里面,就没有这个限制了,所以这个程序在outlook 2003 vba里实现。
   首先在文件夹下建立如下的名称为邮件地址的excel文件,格式如图,第一列是工作表名,第二列是对应要发过去的邮件地址:
   

 

图片

     然后设置outlook 2003的账户能够发送和接收邮件,步骤自己谷歌。最后在outlook vba环境里加入如下代码:


Dim Path As String


Sub main()

Path = "c:\vbamail" '工资所在文件夹

Set app = CreateObject("excel.application")

Set cl = app.workbooks.Open(Path & "\邮件地址.xls")

For i = 1 To cl.worksheets(1).usedrange.rows.Count

   Call sendmail(cl.worksheets(1).cells(i, 1).Value, cl.worksheets(1).cells(i, 2).Value)

Next

cl.Close

Set cl = Nothing

Set app = Nothing

End Sub


Sub sendmail(name As String, address As String)

Set omailitem = Application.CreateItem(0)

omailitem.To = address

omailitem.Subject = "你好!" '邮件标题

omailitem.Body = "你的工资单!" '邮件正文

omailitem.Attachments.Add Path & "\" & name & ".xls"

omailitem.Send

Set omailitem = Nothing

End Sub


      执行里面的mian宏,就可以按照excel邮件地址群发所有个人的工资单了。

      所有文件的dbank示例下载:http://dl.dbank.com/c0bdwo81sy

      这里是我上课时分开的几个例子,应该是能够3个步骤合在一起,直接在outlook vba里面实现的,这个就打算留给学生作为课堂作业了。。。。

  评论这张
 
阅读(1592)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017