访问 vba 等待代码完成（通过 CDO 发送电子邮件）

Question

我有以下代码：

Sub OutputExpences()
Dim strPath As String
Dim FileName As String
Dim TodayDate As String

TodayDate = Format(Date, "DD-MM-YYYY")
strPath = Application.CurrentProject.Path & "\Temp\"
FileName = "Report-Date_" & TodayDate & ".xlsx"

DoCmd.OutputTo acOutputForm, "frmExpences", acFormatXLSX, strPath & FileName, False
            '*** Check Network Connection ***
            If IsInternetConnected() = True Then
                ''' connected
                EmailToCashier
            Else
                ''' no connected
            End If
            '*** Check Network Connection ***
Kill strPath & FileName
End Sub



 Public Sub EmailToCashier()
 Dim mail    As Object           ' CDO.MESSAGE
 Dim config  As Object           ' CDO.Configuration
 Dim strPath As String
 Dim FileName As String
 Dim TodayDate As String

 TodayDate = Format(Date, "DD-MM-YYYY")
 strPath = Application.CurrentProject.Path & "\Temp\"
 FileName = "Report-Date_" & TodayDate & ".xlsx"

     Set mail = CreateObject("CDO.Message")
     Set config = CreateObject("CDO.Configuration")

     config.Fields(cdoSendUsingMethod).Value = cdoSendUsingPort
     config.Fields(cdoSMTPServer).Value = "smtp value"
     config.Fields(cdoSMTPServerPort).Value = 465
     config.Fields(cdoSMTPConnectionTimeout).Value = 10
     config.Fields(cdoSMTPUseSSL).Value = "true"
     config.Fields(cdoSMTPAuthenticate).Value = cdoBasic
     config.Fields(cdoSendUserName).Value = "email value"
     config.Fields(cdoSendPassword).Value = "password value"
     config.Fields.Update
     Set mail.Configuration = config

     With mail
         .To = "email"
         .From = "email"
         .Subject = "subject"
         .TextBody = "Thank you."
         .AddAttachment strPath & FileName
         .Send
     End With

     MsgBox "Email successfully sent!", vbInformation, "EMAIL STATUS"

     Set config = Nothing
     Set mail = Nothing
 End Sub

我需要等待（用户不能按任何东西或做任何事情）直到所有代码完成。

EmailToCashier 正在将输出文件发送到电子邮件，因此需要时间（2-15 秒，具体取决于网络连接和文件大小）。

谢谢。

Answer 1

我创建了一个带有模式和弹出窗口的表单 frmWait。所以，我首先打开 frmWait，然后发送我的电子邮件。发送电子邮件后，表单关闭。

简单，运行良好。

Answer 2

我通常在 Access 中编写，但很多 VBA 是相同的。每当我有一个漫长的过程时，我都会尝试为用户提供一些可以查看的内容，从而为他们提供状态。 在您的情况下，为什么不创建一个单独的用户表单，简单地说“请稍候。发送邮件”。当您运行 EmailToCashier 并在消息框之前将其关闭时，将其作为模式弹出窗口（而不是对话框）打开。这应该允许您的代码运行，但在返回控制权之前阻止用户输入。

Answer 3

使用 Application.wait

Sub OutputExpences()
Dim strPath As String
Dim FileName As String
Dim TodayDate As String

TodayDate = Format(Date, "DD-MM-YYYY")
strPath = Application.CurrentProject.Path & "\Temp\"
FileName = "Report-Date_" & TodayDate & ".xlsx"

DoCmd.OutputTo acOutputForm, "frmExpences", acFormatXLSX, strPath & FileName, False
            '*** Check Network Connection ***
            If IsInternetConnected() = True Then
                ''' connected
                EmailToCashier
            Else
                ''' no connected
            End If
            '*** Check Network Connection ***
    newHour = Hour(Now())
    newMinute = Minute(Now())
    newSecond = Second(Now()) + 15
    waitTime = TimeSerial(newHour, newMinute, newSecond)
    Application.Wait waitTime
Kill strPath & FileName
End Sub