访问 vba 等待代码完成(通过 CDO 发送电子邮件)
access vba wait for code to finish (send E-Mail via CDO)
我有以下代码:
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 秒,具体取决于网络连接和文件大小)。
谢谢。
使用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
我通常用 Access 写,但很多 VBA 都是一样的。每当我有一个漫长的过程时,我都会尝试为用户提供一些可以让他们了解状态的东西。
在你的情况下,为什么不创建一个单独的用户表单,简单地说 "Please Wait. Sending Mail." 当你 运行 EmailToCashier 时将其作为模式弹出窗口(而不是对话框)打开,并在你的消息框之前关闭它。这应该允许您的代码 运行 但在返回控制权之前阻止用户输入。
我创建了一个带有模式和弹出窗口的表单 frmWait。所以,我首先打开 frmWait,然后发送我的电子邮件。发送电子邮件后,表格关闭。
简单而且工作正常。
我有以下代码:
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 秒,具体取决于网络连接和文件大小)。
谢谢。
使用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
我通常用 Access 写,但很多 VBA 都是一样的。每当我有一个漫长的过程时,我都会尝试为用户提供一些可以让他们了解状态的东西。 在你的情况下,为什么不创建一个单独的用户表单,简单地说 "Please Wait. Sending Mail." 当你 运行 EmailToCashier 时将其作为模式弹出窗口(而不是对话框)打开,并在你的消息框之前关闭它。这应该允许您的代码 运行 但在返回控制权之前阻止用户输入。
我创建了一个带有模式和弹出窗口的表单 frmWait。所以,我首先打开 frmWait,然后发送我的电子邮件。发送电子邮件后,表格关闭。
简单而且工作正常。