Получить доступ к vba, дождаться завершения кода (отправить E-Mail через 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 секунд в зависимости от сетевого подключения и размера файла).

Спасибо.

3 ответа

Решение

Я создаю форму frmWait с модальной и всплывающих окон. Итак, я сначала открываю frmWait, а затем отправляю свою электронную почту. После электронной почты форма закрывается.

Просто и работает нормально.

Используйте 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 одинаковы. Всякий раз, когда у меня долгий процесс, я стараюсь дать пользователю что-то, на что он смотрит, что дает ему статус. В вашем случае, почему бы не создать отдельную форму пользователя, которая просто говорит: "Пожалуйста, подождите. Отправка почты". Откройте его как модальное всплывающее окно (не диалоговое окно) при запуске EmailToCashier и закройте его непосредственно перед окном сообщения. Это должно позволить вашему коду работать, но запретить ввод данных пользователем, пока контроль не будет возвращен.

Другие вопросы по тегам