Excel VBA验证自动电子邮件状态

Scott Fiander 发表于 Dev

斯科特·Fiander

到目前为止，我一直在网上无济于事。我有一个带有关联VBA代码的Excel电子表格，该电子表格每天在特定时间通过电子邮件将工作簿的内容发送给我工作的公司中的其他人。

此代码处于无限循环中，很少关闭。我们将其安装在一台计算机上，以全天执行此操作，以计算和更新Intranet上的各种内容。在每天的不同时间使用延时功能访问一些工作簿。

问题在于，有时代码运行得很快，最终发送的是同一工作簿的两封电子邮件，而不是一封。请参考下面的代码：

Private Declare Sub Sleep Lib "kernal32" (ByVal dwMilliseconds As Long)

Private Sub Workbook_Open()
Do While 1
Start = Timer

If Hour(Now())=13 & Minute(Now())>=45 Then
s = "path to file"
Application.DisplayAlerts = False
Workbooks.Open Filename:=s
ActiveWorkbook.SendMail Recipients:="[email protected]"
ActiveWindow.Close
End If

delay = Int(600 - (Timer - Start))
If delay>0 Then
delay = delay * 1000
Sleep delay
End If
Loop

End Sub

正如我所说，有更多的工作簿已激活并对其进行了计算，但也无需编写该代码。它们都遵循与上述几乎相同的格式。

我认为，如果我在循环中使用睡眠设置，则只能发送一次电子邮件，但这会花费太多时间。

我正在考虑使用一个简单的if语句来检查是否今天发送了一封电子邮件（使用Date？），如果是，只需关闭活动窗口，否则发送一封电子邮件。这样可以确保每个工作簿每天仅发送一封电子邮件。我唯一的麻烦是如何准确地编写代码...

关于我们正在使用的有关SendMail加载项的文档，我在网上找不到多少东西。我尝试的所有操作都出现错误，并且我不知道如何解决此问题。我尝试过的一个例子是：

If SendMail = False Then
"send the email"
Else
"close"

显然这是行不通的，但是值得尝试。

因此，如果有人可以帮助我，将不胜感激！

悉达思·劳特

我不确定您使用的时隙，但是我想问题是延迟不够好，因此您收到了两次电子邮件。

这是我尝试和测试的代码。我使用的方法与您使用的方法稍有不同，在该方法中，我与Outlook进行后期绑定，并将excel文件作为附件发送。这种方法的好处是您不必打开工作簿。

测试条件

'Based on your comment, Testing for 4 different workbooks
'for 4 diff time intervals
'Time interval 1 : 11:30 PM - 11:35PM     C:\Temp\Book1.xlsx
'Time interval 2 : 11:35 PM - 11:40PM     C:\Temp\Book2.xlsx
'Time interval 3 : 11:40 PM - 11:45PM     C:\Temp\Book3.xlsx
'Time interval 4 : 11:45 PM - 11:50PM     C:\Temp\Book4.xlsx

逻辑

逻辑是设置该Wait值，使其不会再次重新进入同一循环。如果您在IF条件中指定开始时间和结束时间，则与您在代码中仅指定开始时间的情况不同，这也会有所帮助。

我已对代码进行了注释，以使您在理解代码时不会遇到问题。如果您仍然这样做，只需回发即可。

码

Private Sub Workbook_Open()
    Dim B1 As String, B2 As String, B3 As String, B4 As String
    Dim sEmail As String
    Dim SendEml As Boolean

    Dim OutApp As Object, OutMail As Object

    'Testing for 4 different workbooks for 4 diff time intervals
    'Time interval 1 : 11:30 PM - 11:35PM     C:\Temp\Book1.xlsx
    'Time interval 2 : 11:35 PM - 11:40PM     C:\Temp\Book2.xlsx
    'Time interval 3 : 11:40 PM - 11:45PM     C:\Temp\Book3.xlsx
    'Time interval 4 : 11:45 PM - 11:50PM     C:\Temp\Book4.xlsx

    B1 = "C:\Temp\Book1.xlsx"
    B2 = "C:\Temp\Book2.xlsx"
    B3 = "C:\Temp\Book3.xlsx"
    B4 = "C:\Temp\Book4.xlsx"

    '~~> Email Address
    sEmail = "[email protected]"

    Do
        Select Case Hour(Now())
            '~~> I have only one case here as I am checking for 11PM
            '~~> If your time slots fall under differnt hours then
            '~~> Create more cases accordingly
            Case 23
                If Minute(Now()) >= 20 And Minute(Now()) < 25 Then
                    FileToAttach = B1: SendEml = True
                ElseIf Minute(Now()) >= 25 And Minute(Now()) < 30 Then
                    FileToAttach = B2: SendEml = True
                ElseIf Minute(Now()) >= 30 And Minute(Now()) < 35 Then
                    FileToAttach = B3: SendEml = True
                ElseIf Minute(Now()) >= 35 And Minute(Now()) < 40 Then
                    FileToAttach = B4: SendEml = True
                End If
        End Select

        '~~> Latebind with Outlook to send the email
        If SendEml = True Then
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                .To = sEmail
                .Subject = "SO Example"
                .Body = "Hi Scott :)"
                .Attachments.Add FileToAttach '<~~ This is where we attach the file
                .Send
            End With
            SendEml = False
        End If

        '~~> I have set the wait time for 200 seconds which is about 3.3 mins
        '~~> Change as applicable. You have to ensure that you set this carefully
        '~~> So that the Do Loop doesn't run in the same time frame else you will
        '~~> get duplicate emails.
        Wait 200
    Loop
End Sub

Private Sub Wait(ByVal nSec As Long)
    nSec = nSec + Timer
    While nSec > Timer
        DoEvents
    Wend
End Sub