Excel单元格发生变化后,使用Outlook给特定的人发邮件

时间:2024-10-11 13:38:02

自己在公司里面维护了一个小金库的Excel,当某个人的余额小于0的时候,Outlook会自动给这个人发一封邮件,同时将这个Excel附在邮件中,具体的代码如下:

Public Function sendEmail(mailTo As String)
Application.ScreenUpdating = False
Dim outapp As Object
Dim outmail As Object
Dim body As String
Dim fname As String Set outapp = CreateObject("Outlook.Application")
Set outmail = outapp.CreateItem() fname = "T:\Controlled\Cao Qingsong\Bills_of_EE.xlsm" '这里设置你要附的文件
body = "Please see attached." '这里设置你的邮件内容 On Error Resume Next
With outmail
.To = mailTo '收件人
'.CC = "name3@hotmail.com; name4@gmail.com" '抄送人
'.BCC = "name5@tom.com; name6@qq.com" '密送人
.Subject = "小金库明细" '这里是你的主题
.body = body
.Attachments.Add fname
'.Display '显示发信窗口
.Send '执行发信动作
End With
On Error GoTo Set outmail = Nothing
Set outapp = Nothing Application.ScreenUpdating = True
End Function Private Sub Worksheet_Change(ByVal Target As Range) newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) +
waitTime = TimeSerial(newHour, newMinute, newSecond) Application.DisplayAlerts = False
ThisWorkbook.Save
'Application.Wait 1 Application.EnableEvents = False
If Sheet1.Range("E1").Value < Then
sendEmail ("xxx@xxx.com")
End If
Application.EnableEvents = True
End Sub