How can I run an Excel macro from an Outlook macro? - excel

Question

How can I run an Excel macro from an Outlook macro?

Answer 1

You will need to add the Microsoft Excel 14.0 Data Objects library. Go to Tools -> References.
You will also need to open the workbook before you can run a macro from it.
This should work:
Dim ExApp As Excel.Application
Dim ExWbk As Workbook
Set ExApp = New Excel.Application
Set ExWbk = ExApp.Workbooks.Open("C:\Folder\Folder\File.xls")
ExApp.Visible = True
ExWbk.Application.Run "ModuleName.YourMacro"
ExWbk.Close SaveChanges:=True
If you want to run this macro in the background and not open a visible instance of Excel, then set ExApp.Visible to False.

Answer 2

I just wanted to share how I do this. It doesn't apply to OP's needs, but the title may lead others here for more what I'm sharing. This will (optionally filter by sender/subject) save/open/run macro from spreadsheet received in outlook. I then have a macro in excel sometimes which sends notification/response etc, but I don't do this from Outlook (probably could though!).
Create a VBS script which will launch the excel file and run a macro (optionally the macro can be stored in a separate spreadsheet.)
"runmacro.vbs"
Set args = Wscript.Arguments
ws = WScript.Arguments.Item(0)
macro = WScript.Arguments.Item(1)
If wscript.arguments.count > 2 Then
macrowb = WScript.Arguments.Item(2)
End If
LaunchMacro
Sub LaunchMacro()
Dim xl
Dim xlBook
Set xl = CreateObject("Excel.application")
Set xlBook = xl.Workbooks.Open(ws, 0, True)
If wscript.arguments.count > 2 Then
Set macrowb = xl.Workbooks.Open(macrowb, 0, True)
End If
'xl.Application.Visible = True ' Show Excel Window
xl.Application.run macro
'xl.DisplayAlerts = False ' suppress prompts and alert messages while a macro is running
'xlBook.saved = True ' suppresses the Save Changes prompt when you close a workbook
'xl.activewindow.close
xl.Quit
End Sub
Outlook VBA Code (ThisOutlookSession):
https://www.slipstick.com/outlook/email/save-open-attachment/
Private Declare Function GetShortPathName Lib "kernel32" _
Alias "GetShortPathNameA" (ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Sub objItems_ItemAdd(ByVal Item As Object)
Dim objMail As Outlook.MailItem
Dim objWsShell As Object
Dim strTempFolder As String
Dim objAttachments As Outlook.Attachments
Dim objAttachment As Attachment
Dim strFileName As String
Dim Subject As String
Subject = Item.Subject
'If Subject Like "*SubTest*" Then
If Item.Class = olMail Then
Set objMail = Item
'Change sender email address
'If objMail.SenderEmailAddress = "boss#datanumen.com" Then
Set objWShell = CreateObject("WScript.Shell")
strTempFolder = Environ("Temp") & "\"
Set objWsShell = CreateObject("WScript.Shell")
Set objAttachments = objMail.Attachments
If objAttachments.Count > 0 Then
For Each objAttachment In objAttachments
strFileName = objAttachment.DisplayName
On Error Resume Next
Kill strTempFolder & strFileName
On Error GoTo 0
'Save the attachment
objAttachment.SaveAsFile strTempFolder & strFileName
'Open the attachment
vbs = (Chr(34) & "\\Server\Excel\" & "\runmacro.vbs " & Chr(34))
strFileName = GetShortFileName(strTempFolder & strFileName)
macro = "MacroName"
xlam = Environ("APPDATA") & "\Microsoft\Excel\XLSTART\Add-In.xlam"
On Error Resume Next
objWsShell.Run vbs & " " & strFileName & " " & macro & " " & xlam
objMail.UnRead = False
Next
'End If
End If
End If
'End If
End Sub
Function GetShortFileName(ByVal FullPath As String) As String
Dim lAns As Long
Dim sAns As String
Dim iLen As Integer
On Error Resume Next
If Dir(FullPath) <> "" Then
sAns = Space(255)
lAns = GetShortPathName(FullPath, sAns, 255)
GetShortFileName = Left(sAns, lAns)
End If
End Function