VBA 中的 Arena 模拟开始和关闭答案

【问题标题】：Arena Simulation Start and Close in VBAVBA 中的 Arena 模拟开始和关闭
【发布时间】：2020-02-22 23:53:58
【问题描述】：

目前我正在为一个学术项目使用 Arena Simulation。我想通过VBA启动acadamic Arena版本的模型，运行模型并自动关闭。

到目前为止，Arena 模型打开但未运行。 Arena 中的运行按钮（用于启动模型模拟）的单击丢失。如何在 VBA 中“单击”运行按钮？

我当前的代码部分：

Private Function ExecuteArena(ByVal arenaFile As String, ByVal arenaPath As String)

On Error GoTo ErrorHandler

''' Clear the error mesaage variable.
gszErrMsg = vbNullString

''' Shell out
If Not bShellAndWait(arenaPath & " " & arenaFile & " ", 6) Then Err.Raise 9999

Exit Function

ErrorHandler:
''' If we ran into any errors this will explain what they are.
MsgBox gszErrMsg, vbCritical, "Shell and Wait Error"

End Function

   Private Function bShellAndWait(ByVal szCommandLine As String, Optional ByVal iWindowState As Integer = vbHide) As Boolean
Dim lTaskID As Long
Dim lProcess As Long
Dim lExitCode As Long 
Dim lResult As Long

On Error GoTo ErrorHandler

''' Run the Shell function.
lTaskID = Shell(szCommandLine, iWindowState)

''' Check for errors.
If lTaskID = 0 Then Err.Raise 9999, , "Shell function error."

''' Get the process handle from the task ID returned by Shell.
lProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0&, lTaskID)

''' Check for errors.
If lProcess = 0 Then Err.Raise 9999, , "Unable to open Shell process handle."

''' Loop while the shelled process is still running. 
Do
 ''' lExitCode will be set to STILL_ACTIVE as long as the shelled process is running.
 lResult = GetExitCodeProcess(lProcess, lExitCode)
 DoEvents
Loop While lExitCode = STILL_ACTIVE

bShellAndWait = True
Exit Function

ErrorHandler:
 gszErrMsg = Err.Description
 bShellAndWait = False
End Function

【问题讨论】：

标签： vba arena-simulation

【解决方案1】：

我找到了我的问题的答案。首先，您必须在 VBA 中激活 Arena 库。 Extra-->References-->选择“Arena 14.0 Type Library”。然后，您可以使用此代码打开、运行和结束 Arena 模型。

'Declare variables
Dim oArenaApp As Arena.Application
Dim oModel As Arena.Model, oSIMAN As Arena.SIMAN
Dim oModule As Arena.Module

'Start Arena, open model, make Arena active & visible
Set oArenaApp = CreateObject("Arena.Application")
ModName = "YOUR FILEPATH"
Set oModel = oArenaApp.Models.Open(ModName)
Set oSIMAN = oModel.SIMAN
oArenaApp.Activate
oArenaApp.Visible = True

'Run model in batch mode and send results back to Excel
oModel.BatchMode = True ' Turn off animation
oModel.QuietMode = True ' Do not ask final question
oModel.Go (smGoWait) ' Suspend VB until run ends    

'End model run and exit Arena
oModel.End
oArenaApp.Visible = False

【讨论】：