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

自己在公司里面维护了一个小金库的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(0)

    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 0
    
    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()) + 1
    waitTime = TimeSerial(newHour, newMinute, newSecond)
    
    Application.DisplayAlerts = False
    ThisWorkbook.Save
    'Application.Wait 1
    
    Application.EnableEvents = False
    If Sheet1.Range("E1").Value < 0 Then
        sendEmail ("xxx@xxx.com")
    End If
    Application.EnableEvents = True
End Sub

 

posted @ 2015-12-04 16:46  朝雾之归乡  阅读(1317)  评论(0编辑  收藏  举报