vba 如何从 Outlook 宏运行 Excel 宏？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/24452266/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How can I run an Excel macro from an Outlook macro?
提问by ZHE.ZHAO
How can I run an Excel macro from an Outlook macro?
如何从 Outlook 宏运行 Excel 宏？
回答by asp8811
You will need to add the Microsoft Excel 14.0 Data Objects library. Go to Tools -> References.
您将需要添加 Microsoft Excel 14.0 数据对象库。转到工具 -> 参考。
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.
如果要在后台运行此宏而不打开 Excel 的可见实例，请将 ExApp.Visible 设置为 False。
回答by FreeSoftwareServers
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!).
我只是想分享我是如何做到这一点的。它不适用于 OP 的需求，但标题可能会引导其他人在这里获得更多我分享的内容。这将（可选择按发件人/主题过滤）从 Outlook 中收到的电子表格中保存/打开/运行宏。然后我在 excel 中有一个宏有时会发送通知/响应等，但我不会从 Outlook 执行此操作（虽然可能可以！）。
Create a VBS script which will launch the excel file and run a macro (optionally the macro can be stored in a separate spreadsheet.)
创建一个 VBS 脚本，该脚本将启动 excel 文件并运行宏（可选地，宏可以存储在单独的电子表格中。）
"runmacro.vbs"
“运行宏.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):
Outlook VBA 代码 (ThisOutlookSession)：
https://www.slipstick.com/outlook/email/save-open-attachment/
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 = "[email protected]" 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
