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

使用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

Answer 2

我通常用Access编写，但很多VBA都是一样的。每当我有一个漫长的过程时，我会尝试给用户一些东西来给他们提供状态。在您的情况下，为什么不创建一个单独的用户表单，简单地说＆＃34;请等待。发送邮件。＆＃34;当您运行EmailToCashier并在消息框之前关闭它时，将其作为模式弹出窗口（而不是对话框）打开。这应该允许您的代码运行，但在返回控件之前阻止用户输入。

Answer 3

我用模态和弹出窗口创建窗体frmWait。因此，我首先打开frmWait，然后发送我的电子邮件。发送电子邮件后，表格关闭。

简单，可以正常工作。

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

3 个答案: