1

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

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

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

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:="someone@someone.com"
ActiveWindow.Close
End If

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

End Sub

正如我所说，有更多的工作簿被激活并对其进行了计算，但也不需要放置代码。这一切都遵循与上面几乎相同的格式。

我想如果我在循环中使用睡眠设置，我可以让它只发送一次电子邮件，但这会花费太多时间。

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

关于我们正在使用的 SendMail 插件的文档，我在网上找不到太多。我尝试的一切都会出现错误，我不知道如何解决这个问题。我尝试过的一个例子是：

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

显然这行不通，但值得一试。

因此，如果有人可以帮我解决这个问题，将不胜感激！

4

1 回答 1

2

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

这是我尝试和测试的代码。我使用的方法与您的方法略有不同，其中我与 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 = "someone@someone.com"

    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
于 2013-09-17T18:16:30.370 回答