如何用VBA监督小弟是否摸鱼？插入这段代码！

Mengkelyu

珂珂吃饭的时候灵机一动，有了新的坏主意（划掉）好想法。
如果在给小弟的excel中插入一段代码，每天监督他的工作开始时间，那不是很妙嘛。

实现的功能是，小弟打开Excel时，自动给我的邮箱发类似下面的邮件。

注意，下面的方法需要电脑里面已经安装并运行着Outlook.

Mengkelyu

代码的实现超级简单。只要双击VBA Project里面的[ThisWorkbook]

在代码栏的上方选择Workbook + Open

然后会自动跳出下面的代码

Private Sub Workbook_Open()
End Sub

在这个Procedure里面插入下面的代码

Private Sub Workbook_Open()

Dim time As Double

time = Now()
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")

' CREATE EMAIL OBJECT.
    Dim objEmail As Object
    Set objEmail = objOutlook.CreateItem(0)

    With objEmail
        .to = "mengke.lyu@gmail.com" '这是我的邮箱
        .Subject = "Alert"
        .Body = "Keke opened her excel at " & Format(time, "Medium Time")
        .Send        ' Send the message in Outlook.
    End With
    
    ' CLEAR.
    Set objEmail = Nothing:    Set objOutlook = Nothing

End Sub

就可以啦，这段代码就会在打开Excel的时候自动运行

Mengkelyu

同样的道理，也可以在关闭Excel前发送类似邮件，快点试试吧~

Mengkelyu

那么，如果小弟去上厕所太久怎么办呢？写了另一个宏，如果两次写入Worksheet的时间间隔大于1小时，那么就会发邮件。如何实现呢？
双击想要监视的Worksheet（比如这里的Sheet1）

，然后写入这样的代码

Option Explicit

Dim time As Date


Private Sub Worksheet_Change(ByVal Target As Range)
Dim newtime As Date
newtime = Now()
Debug.Print newtime
Debug.Print time
Debug.Print DateDiff("n", time, newtime)
If DateDiff("n", time, newtime) > 60 And time <> 0 Then

Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")

' CREATE EMAIL OBJECT.
    Dim objEmail As Object
    Set objEmail = objOutlook.CreateItem(0)

    With objEmail
        .to = "mengke.lyu@gmail.com"
        .Subject = "Alert"
        .Body = "No action in " & DateDiff("n", time, newtime) & " minutes"
        .Send        ' Display the message in Outlook.
    End With
    
    ' CLEAR.
    Set objEmail = Nothing:    Set objOutlook = Nothing
Else

time = newtime

End If
End Sub

小弟摸鱼太久再用Excel的时候，就可以发送下面的邮件啦