Save email attachment based on email subject

Question

Ever day at 12 am there is an automatic email with an excel attachment from a vendor service with a specific subject. I am using rules and code to attempt to save the attachment and insert the information into a database I have created upon being received in the inbox.

I have tried code that I have found online however I don't know if doesn't work because of some network/ security setting my company has or if its he code it self.

Rule:

CODE:

Public Sub CribMaster2Database(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String

saveFolder = "c:\temp\"
    If olItem.Subject = "Test" Then
        For Each objAtt In itm.Attachments
            objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
            Set objAtt = Nothing
        Next
    End If

End Sub

Answer 1

将代码添加到ThisOutlookSession以观看您的文件夹以便到达 只要有东西到达您收看的文件夹，CribMaster_ItemAdd就会触发。

在模块的最顶层：

Dim WithEvents CribMaster As Items

Const SAVE_PATH As String = "c:\temp\"

Private Sub Application_Startup()

    Dim ns As Outlook.NameSpace
    Set ns = GetNamespace("MAPI")

    'Change `holi4683` to the name of your account
    '(should be visible just above your inbox).
    Set CribMaster = ns.Folders.Item("holi4683") _
            .Folders.Item("Inbox").Items

End Sub

Sub CribMaster_ItemAdd(ByVal Item As Object)
    Dim olAtt As Attachment
    Dim i As Integer

    With Item
        For i = 1 To .Attachments.Count
            Set olAtt = .Attachments(i)
            olAtt.SaveAsFile SAVE_PATH & olAtt.DisplayName
            .UnRead = False
            DoEvents
        Next i
    End With
    Set olAtt = Nothing

End Sub  

我通常会使用规则将电子邮件移动到子文件夹并观看该文件夹 - 这意味着我不必担心会议邀请等。
要执行此操作，您需要更改您观看的文件夹：

Set CribMaster = ns.Folders.Item("holi4683") _
        .Folders.Item("Inbox") _
        .Folders.Item("SubFolder").Items  

重新启动Outlook以使代码生效，或手动运行Application_Startup()过程。