VBA

VBA typically serves for embedding a Mosel model into an Excel spreadsheet. In this section we shall only show the parts relevant to the Mosel functions, assuming that the execution of a model is trigged by the action of clicking on some object such as the buttons shown in Figure Excel spreadsheet embedding VBA macros.

Figure 17.1: Excel spreadsheet embedding VBA macros

Compiling and executing a model in VBA

As with the other programming languages, to execute a Mosel model in VBA we need to perform the standard compile/load/run sequence as shown in the following example (contained in the file ugvb.bas). We use a slightly modified version burglar5.mos of the burglar problem where we have redirected the output printing to the file burglar_out.txt.

Private Sub burglar_Click()
  Dim model
  Dim ret As Long
  Dim result As Long
  Dim outfile As String, moselfile As String

'Initialize Mosel
  ret = XPRMinit
  If ret Then
    MsgBox "Initialization error (" & ret & ")"
    Exit Sub
  End If

'Compile burglar5.mos
  XPRMsetdefworkdir GetFullPath()
  moselfile = GetFullPath() & "\" & "burglar5"
  outfile = GetFullPath() & "\" & "burglar_out.txt"
  ret = XPRMcompmod(vbNullString, moselfile & ".mos", vbNullString, _
        "Burglar problem")
  If ret <> 0 Then
    MsgBox "Compile error (" & ret & ")"
    Exit Sub
  End If

'Load burglar5.bim
  model = XPRMloadmod(moselfile & ".bim", vbNullString)
  If model = 0 Then
    MsgBox "Error loading model"
    Exit Sub
  End If

'Run the model
  ret = XPRMrunmod(model, result, "OUTFILE=""" & Replace(outfile, "\", _
        "\\") & """")
  If ret <> 0 Then
    MsgBox "Execution error (" & ret & ")"
    GoTo done
  Else
    ShowFile outfile
  End If
  MsgBox vbNewLine & "model Burglar returned: " & result

done:
  XPRMfree
End Sub

'Auxiliary routines
Private Sub ShowFile(fn As String)
  Dim vs As String
  vs = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
  MsgBox vs
End Sub

Private Function GetFullPath() As String
  Dim path As String
  path = ThisWorkbook.path
  If Right(path, 1) = "\" Then path = Left(path, Len(path) - 1)
  GetFullPath = path
End Function

This implementation redirects the output into a log file vbout.txt the contents of which is displayed after a successful model run.

Parameters

When executing a Mosel model in VBA, it is possible to pass new values for its parameters into the model. The following program (also contained in the file ugvb.frm) extract shows how we may run model `Prime' from Section Working with sets to obtain all prime numbers up to 500 (instead of the default value 100 set for the parameter LIMIT in the model). We use a slightly modified version prime4.mos of the model where we have redirected the output printing to a file denoted by the parameter OUTFILE.

Private Sub prime_Click()
  Dim model
  Dim ret As Long
  Dim result As Long
  Dim outfile As String, moselfile As String

'Initialize Mosel
  ret = XPRMinit
  If ret Then
    MsgBox "Initialization error (" & ret & ")"
    Exit Sub
  End If

'Compile prime4.mos
  XPRMsetdefworkdir GetFullPath()
  moselfile = GetFullPath() & "\" & "prime4"
  outfile = GetFullPath() & "\" & "vbout.txt"
  ret = XPRMcompmod(vbNullString, moselfile & ".mos", vbNullString, _
        "Prime numbers")
  If ret <> 0 Then
    MsgBox "Compile error (" & ret & ")"
    Exit Sub
  End If

'Load prime4.bim
  model = XPRMloadmod("prime4.bim", vbNullString)
  If model = 0 Then
    MsgBox "Error loading model"
    Exit Sub
  End If

'Run model with new parameter settings
  ret = XPRMrunmod(model, result, "LIMIT=500,OUTFILE=""" & Replace(outfile, _
        "\", "\\") & """")

  If ret <> 0 Then
    MsgBox "Execution error (" & ret & ")"
    GoTo done
  Else
    ShowFile outfile
  End If
  MsgBox vbNewLine & "model Prime returned: " & result

done:
  XPRMfree
End Sub

Redirecting the Mosel output

In the previous example we have hardcorded the redirection of the output directly in the model. With Mosel's VBA interface the user may also redirect all output produced by Mosel to files directly from the host application, that is, redirect the output stream.

To redirect all output of a model to the file myout.txt add the following function call before the execution of the Mosel model:

' Redirect all output to the file "myout.txt"
 XPRMsetdefstream 0, XPRM_F_OUTPUT, "myout.txt"

Similarly, any possible error messages produced by Mosel can be recovered by replacing in the line above XPRM_F_OUTPUT by XPRM_F_ERROR. This will redirect the error stream to the file myout.txt.

The following VBA program extract (file ugcb.bas) shows how to use a callback in VBA to receive all output from a Mosel model (standard output and errors). The output will be displayed in the spreadsheet from where the model run was started.

Private ROWNUM As Long
Public Sub example()
  Dim ret As Long
  Dim result As Long
  Dim module

  ClearColumn

' Initialize Mosel. Must be called first
  ret = XPRMinit
  If ret <> 0 Then
    PrintLn ("Failed to initialize Mosel")
    Exit Sub
  End If

' Redirect the output and error streams to the callback
  ret = XPRMsetdefstream(0, XPRM_F_OUTPUT, XPRM_IO_CB(AddressOf OutputCB))
  ret = XPRMsetdefstream(0, XPRM_F_ERROR, XPRM_IO_CB(AddressOf OutputCB))

  PrintLn "Starting model..."

' Run the model
  ret = XPRMexecmod("", GetFullPath() & "\" & "burglar10.mos", _
                    "FULLPATH='" & GetFullPath() & "'", result, module)
  If ret <> 0 Then
    PrintLn ("Failed to execute model")
    GoTo done
  Else
    PrintLn "Finished model"
  End If

  done:
    XPRMfree
End Sub

#If VBA7 Then
Private Sub OutputCB(ByVal model As LongPtr, ByVal ref As LongPtr, _
                    ByVal msg As String, ByVal size As Long)
  ' Output to the spreadsheet
  Call PrintLn(msg)
End Sub
#Else
Private Sub OutputCB(ByVal model As Long, ByVal ref As Long, _
                    ByVal msg As String, ByVal size As Long)
  ' Output to the spreadsheet
  Call PrintLn(msg)
End Sub
#End If

Public Sub PrintLn(ByVal msg As String)
  ' Strip any trailing newlines first
  If Right(msg, Len(vbLf)) = vbLf Then msg = Left(msg, Len(msg) - Len(vbLf))
  If Right(msg, Len(vbCr)) = vbCr Then msg = Left(msg, Len(msg) - Len(vbCr))
  Worksheets("Run Model").Cells(ROWNUM, 2) = Trim(msg)
  ROWNUM = ROWNUM + 1
End Sub

Sub ClearColumn()
  Worksheets("Run Model").Columns(2).ClearContents
  ROWNUM = 1
End Sub

Function GetFullPath() As String
  Dim path As String
  path = ThisWorkbook.path
  If Right(path, 1) = "\" Then path = Left(path, Len(path) - 1)
  GetFullPath = path
End Function