VBA Outlook вызывает макрос Excel и подождать, пока макрос не будет выполнен
Я вызываю макрос Excel из правила Outlook script.
Процесс:
Получите почту, запустите правило Outlook, которое запускает Outlook script, откройте Excel из этого script, запустите макрос Excel, закройте Excel.
Как я могу проверить в правиле Outlook script, что макрос Excel сделан, чтобы сохранить и закрыть приложение?
Sub AskMeAlerts()
Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook
Set appExcel = CreateObject("Excel.Application")
appExcel.Workbooks.Open ("C:\Ask me question workflow.xlsm")
appExcel.Visible = True
appExcel.Run "'Ask me question workflow.xlsm'!AskMeFlow"
appExcel.DisplayAlerts = False
appExcel.ActiveWorkbook.Save
appExcel.Quit Set appExcel = Nothing
Set wkb = Nothing
End Sub
Ответы
Ответ 1
Вы можете либо
- Перенесите макрос Excel в Outlook и запустите его напрямую.
- Используйте флаг для захвата завершения кода
В приведенном ниже коде используется маркер в A1 первого листа, чтобы поймать выполняемый код (в части Excel). Я также привязал ваш код (это было сочетание ранней и последующей привязки)
код внешнего вида
Sub AskMeAlerts()
Dim appExcel As Excel.Application
Set appExcel = New Excel.Application
With appExcel
.DisplayAlerts = False
.Workbooks.Open ("C:\TEMP\Ask me question workflow.xlsm")
.Run "'Ask me question workflow.xlsm'!AskMeFlow"
If .activeworkbook.sheets(1).[a1].Value = "Complete" Then
MsgBox "Code has run"
.activeworkbook.sheets(1).[a1].Value = vbNullString
.activeworkbook.Save
.DisplayAlerts = True
.activeworkbook.Close
appExcel.Quit
Set appExcel = Nothing
End If
End With
End Sub
код excel
Sub AskMeFloW()
'do stuff
ThisWorkbook.Sheets(1).[a1] = "Complete"
End Sub
Ответ 2
Действительно простой способ - реализовать блокировку.
Этот код является быстрым и грязным решением, проверяя наличие файла в предопределенном месте.
в C:\Ask me question workflow.xlsm
добавить этот под:
Sub WrapAskMeFlow()
Dim tmpFile As String
tmpFile = "C:\AskMeFlow.tmp"
Open tmpFile for Output as #1
Close #1
AskMeFlow
Kill tmpFile
End Sub
В макросе прогноза добавить:
Sub AskMeAlerts()
Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook
Set appExcel = CreateObject("Excel.Application")
appExcel.Workbooks.Open ("C:\Ask me question workflow.xlsm")
appExcel.Visible = True
appExcel.Run "'Ask me question workflow.xlsm'!WrapAskMeFlow"
appExcel.DisplayAlerts = False
While Dir("C:\AskMeFlow.tmp")="":DoEvents:Wend
While Dir("C:\AskMeFlow.tmp")<>"":DoEvents:Wend
appExcel.ActiveWorkbook.Save
appExcel.Quit Set appExcel = Nothing
Set wkb = Nothing
End Sub
Ответ 3
Вариант 1
Простейшим вариантом в вашем конкретном случае было бы создание команд save и quit в макросе Excel, а не в Outlook.
То есть вы можете изменить свой код Outlook на:
Sub AskMeAlerts()
Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook 'Is this declaration necessary for some code elsewhere? You do not use this variable and I would recommend removing the declaration.
Set appExcel = CreateObject("Excel.Application")
With appExcel
.Workbooks.Open ("C:\Ask me question workflow.xlsm")
.Visible = True
.Run "'Ask me question workflow.xlsm'!AskMeFlow"
'No need to explicitly set alert values or save workbook as Excel macro will handle this.
End With
Set appExcel = Nothing
Set wkb = Nothing 'Again, is this necessary?
End Sub
Затем вы можете добавить следующее в конец файла "Ask me question workflow.xlsm":
Application.DisplayAlerts = False
ThisWorkbook.Close SaveChanges:=True
Application.Quit
Примечание. Если вы также будете запускать макрос вручную или в других случаях использования, когда вы не хотите, чтобы книга сохраняла, закрывала и закрывала, вы могли бы рассмотреть возможность добавления входной переменной в макрос AskMeFlow, который по умолчанию имеет значение False, но для Outlook установлено значение True. Я думаю, что это немного выходит за рамки этого ответа, поэтому я не буду подробно останавливаться, но дайте мне знать, если вы заинтересованы в этом варианте.
Вариант 2
отредактированный. См. Решение Uri; улучшения, которые я предложил, принципиально не изменяют это решение.
Вариант 3
В зависимости от характера кода Excel вы можете превратить его в функцию и захватить выходную переменную. Что-то вроде ниже:
Sub AskMeAlerts()
Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook
Dim StrOutput as string
StrOutput = "Excel macro did not complete."
Set appExcel = CreateObject("Excel.Application")
appExcel.Workbooks.Open ("C:\Ask me question workflow.xlsm")
appExcel.Visible = True
StrOutput = appExcel.Run "'Ask me question workflow.xlsm'!AskMeFlow"
MsgBox StrOutput
appExcel.DisplayAlerts = False
appExcel.ActiveWorkbook.Save
appExcel.Quit Set appExcel = Nothing
Set wkb = Nothing
End Sub
Затем вы измените функцию AskMeFlow на функцию и добавьте следующий код:
Function AskMeFlow() as String
AskMeFlow = "Uncaught error executing Excel code."
'Your code here
AskMeFlow = "Excel code completed successfully!"
End Function
Ответ 4
Если Sub AskMeFlow
выполнить вычисления без вмешательства пользователя, я полагаю, вы можете просто просто отслеживать Excel CalculationState
.
Sub AskMeAlerts()
With CreateObject("Excel.Application")
.Workbooks.Open ("C:\Ask me question workflow.xlsm")
.Visible = True
' Ensure Autocalculation is on
.Calculation = -4105 ' xlCalculationAutomatic
.DisplayAlerts = False
.Run "'Ask me question workflow.xlsm'!AskMeFlow"
' Wait until calculation is done
Do Until .CalculationState = 0 ' xlDone
DoEvents
Loop
.ActiveWorkbook.Save
.ActiveWorkbook.Close
.Quit
End With
End Sub
Было бы еще лучше, если AskMeFlow
автоматически выполняется в событии Workbook_Open
(в модуле "ThisWorkbook" ).
Ответ 5
Макрос Excel должен заканчиваться закрытием всех книг,
и Outlook будет ждать, пока еще есть книги.
В Excel:
// do work
Application.ActiveWorkbook.Save
Application.DisplayAlerts = False
For Each wrkbk In Application.Workbooks
If wrkbk.Name <> ThisWorkbook.Name Then wrkbk.Close
Next
ThisWorkbook.Save
ThisWorkbook.Close
Макрос Outlook может объединяться до тех пор, пока Workbooks.Count = zero
While appExcel.Workbooks.Count > 0 :DoEvents:Wend
appExcel.DisplayAlerts = False
appExcel.Quit
Set appExcel = Nothing
Ответ 6
Завершите свой код следующим образом:
On Error Resume Next
On Error GoTo 0
ExitFunction:
Set objShell = Nothing
End Function