Option Explicit
Sub example()
Dim app As Application
Dim wbTarget As Workbook
Dim strReturnedValue As String
Dim strArg As String
'// Supply/Change fullname to suit //
Const FULL_PATH As String = "G:\2011\2011-08-03\New Folder(2)\TempMac.xls"
'// Set a reference to the new instance. //
Set app = New Application
With app
'// Until I am confident no glitches can occur, I would keep the new //
'// instance visible, but reduced for focus. //
.Visible = True
.WindowState = xlMinimized
'// Set a reference to the opening wb in the other instance //
Set wbTarget = app.Workbooks.Open(FULL_PATH)
'// Build any req'd argument(s). The single quotes' placement always //
'// gives me fits. //
strArg = "'" & wbTarget.Name & "'!Module1.TestCalled"
'// Run the code and return whatever... //
strReturnedValue = app.Run(strArg, ThisWorkbook.Name)
MsgBox strReturnedValue
'// Close the otehr wb and kill the instance. //
wbTarget.Close False
.Quit
End With
End Sub
Function TestCalled(ByVal CallingWBName As String) As String
TestCalled = CallingWBName & " called the macro in " & ThisWorkbook.Name & _
", supplied" & CallingWBName & "'s name as a string."
End Function
Is there any way to let the external workbook macros run in parallel (so that we can take advantage of the multicore cpu, which is our purpose of the exercise)?
Option Explicit
Private Type GUID
lData1 As Long
iData2 As Integer
iData3 As Integer
aBData4(0 To 7) As Byte
End Type
Private Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Sub AccessibleObjectFromWindow Lib "OLEACC.DLL" _
(ByVal hwnd As Long, _
ByVal dwId As Long, _
riid As GUID, _
ppvObject As Any)
Private Const OBJID_NATIVEOM = &HFFFFFFF0
Sub RunRemoteMacro()
Dim lPid As Long, i As Long
Dim sRemoteWbName As String, sExeName As String, sParams As String
sExeName = "excel.exe"
sRemoteWbName = "c:\abcd.xlsm"
sParams = " /e" & " -!-" & " "
lPid = Shell(sExeName & sParams & sRemoteWbName, vbMaximizedFocus)
Do
DoEvents
Loop Until lPid <> 0
Do
Range("a1") = i
i = i + 1
DoEvents
Loop
End Sub
Sub StopRemoteMacro()
Dim sArg As String
Dim oXLApp As Application
Set oXLApp = ApplicationFromHwnd()
If Not oXLApp Is Nothing Then
sArg = "'" & oXLApp.Workbooks(1).Name & "'!Module1.CancelMacro"
Call oXLApp.Run(sArg)
'oXLApp.Workbooks(1).Close False
'oXLApp.Quit
Set oXLApp = Nothing
End If
End Sub
Private Sub SetIDispatch(ByRef ID As GUID)
' IDispatch Interface.
' {00020400-0000-0000-C000-000000000046}.
With ID
.lData1 = &H20400
.iData2 = &H0
.iData3 = &H0
.aBData4(0) = &HC0
.aBData4(1) = &H0
.aBData4(2) = &H0
.aBData4(3) = &H0
.aBData4(4) = &H0
.aBData4(5) = &H0
.aBData4(6) = &H0
.aBData4(7) = &H46
End With
End Sub
Private Function ApplicationFromHwnd() As Application
Dim IDispatch As GUID
Dim oWB As Object
Dim lXLhwnd As Long
Dim lXLDESKhwnd As Long
Dim lWBhwnd As Long
Do
lXLhwnd = FindWindowEx(0, lXLhwnd, "XLMAIN", vbNullString)
If lXLhwnd = 0 Then
Exit Do
ElseIf lXLhwnd <> Application.hwnd Then
lXLDESKhwnd = FindWindowEx(lXLhwnd, 0&, "XLDESK", vbNullString)
lWBhwnd = FindWindowEx(lXLDESKhwnd, 0&, "EXCEL7", vbNullString)
If lWBhwnd Then
SetIDispatch IDispatch
Call AccessibleObjectFromWindow _
(lWBhwnd, OBJID_NATIVEOM, IDispatch, oWB)
Set ApplicationFromHwnd = oWB.Application
Exit Do
End If
End If
Loop
Set oWB = Nothing
End Function
Option Explicit
Private Declare Function GetCommandLine Lib "kernel32" _
Alias "GetCommandLineA" () As Long
Private Declare Function lstrlen Lib "kernel32" _
Alias "lstrlenA" _
(ByVal lpString As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pDst As Any, pSrc As Any, _
ByVal ByteLen As Long)
Private Sub Workbook_Open()
If InStr(1, GetCommLine, "-!-") Then
Call RemoteMacro
End If
End Sub
Private Function GetCommLine() As String
Dim RetStr As Long, SLen As Long
Dim Buffer As String
RetStr = GetCommandLine
SLen = lstrlen(RetStr)
If SLen > 0 Then
GetCommLine = Space$(SLen)
CopyMemory ByVal GetCommLine, ByVal RetStr, SLen
End If
End Function
Option Explicit
Private bCancel As Boolean
Sub CancelMacro()
bCancel = True
End Sub
Sub RemoteMacro()
Dim i As Long
bCancel = False
Do
Range("a1") = i
i = i + 1
DoEvents
Loop Until bCancel
MsgBox "Remote Macro Canceled."
End Sub