Question

每当我收到一封发送到Outlook中特定文件夹的电子邮件时，Outlook是否有办法自动运行宏（只是为了澄清，电子邮件是因为我已经设置了规则，所以不要去我的收件箱去那个文件夹）。

我想我需要的代码能够在我的文件夹收到新邮件时检测到，然后自动运行宏。

我的代码如下，我执行test，执行SaveEmailAttachmentsToFolder.

Sub Test()

'Arg 1 = Folder name of folder inside your Inbox 'Arg 2 = File extension, "" is every file 'Arg 3 = Save folder, "C:\Users\Ron\test" or "" ' If you use "" it will create a date/time stamped folder for you in your "Documents" folder ' Note: If you use this "C:\Users\Ron\test" the folder must exist.

SaveEmailAttachmentsToFolder "Dependencia Financiera", "xls", "V:\Dependencia Financiera\Dependencia Financiera\"

End Sub

Sub SaveEmailAttachmentsToFolder(OutlookFolderInInbox As String, _ ExtString As String, DestFolder As String)

Dim ns As NameSpace
Dim Inbox As Folder
Dim SubFolder As Folder

Dim subFolderItems As Items

Dim Atmt As Attachment

Dim FileName As String

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = Inbox.Folders(OutlookFolderInInbox)

Set subFolderItems = SubFolder.Items

If subFolderItems.Count > 0 Then

    subFolderItems.Sort "[ReceivedTime]", True

    For Each Atmt In subFolderItems(1).Attachments
        If LCase(Right(Atmt.FileName, Len(ExtString))) = LCase(ExtString) Then
            FileName = DestFolder & Atmt.FileName
            Atmt.SaveAsFile FileName
        End If
    Next Atmt

End If

' Clear memory ThisMacro_exit:
Set SubFolder = Nothing
Set Inbox = Nothing
Set ns = Nothing
Set subFolderItems = Nothing

End Sub

seulberg1告诉我如何使用以下代码，如果我自己粘贴自己的代码，它有2个Subs。

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup() Dim olApp As Outlook.Application

Set olApp = Outlook.Application Set Items = GetNS(olApp).GetDefaultFolder(olFolderInbox).Folders("YourFolderName").Items End Sub

Private Sub Items_ItemAdd(ByVal item As Object)

On Error GoTo ErrorHandler

'Add your code here

ProgramExit: Exit Sub ErrorHandler: MsgBox Err.Number & " - " & Err.Description Resume ProgramExit End Sub

Function GetNS(ByRef app As Outlook.Application) As Outlook.NameSpace Set GetNS = app.GetNamespace("MAPI") End Function

提前谢谢！

Answer 1

这段代码（改编自Jimmy Pena）应该可以解决问题。

它在Outlook启动时启动事件监听器，并检查文件夹“您的文件夹名称”以查找新电子邮件。然后，它会在（“在此处添加您的代码”）部分执行可指定的操作。

如果有帮助，请告诉我

祝你好运 seulberg1

strip-tags()

触发运行Outlook宏

1 个答案: