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

 

版权声明:本文为cnpirate原创文章,遵循 CC 4.0 BY-SA 版权协议,转载请附上原文出处链接和本声明。
本文链接:https://www.cnblogs.com/cnpirate/p/5019749.html