时间戳

首页 > 解决方案 > 将附件保存到新的 Windows 文件夹？

vba - 将附件保存到新的 Windows 文件夹？

问题描述

每次收到主题为“测试”的电子邮件时，我都想：

  1. 自动提取所有附件并将它们存储在自己新创建的文件夹中。
  2. 自动复制此新文件夹中的电子邮件
  3. 在这个新文件夹中自动添加一个 Word 文档。
  4. 该文件夹必须以收到日期命名。

我拥有的代码复制了预选文件夹中的所有附件，但它不会为它们创建个人文件夹。

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)

On Error GoTo ErrorHandler

    'Only act if it's a MailItem
    Dim Msg As Outlook.MailItem
    If TypeName(item) = "MailItem" Then
        Set Msg = item

    'Change variables to match need. Comment or delete any part unnecessary.
        If (Msg.Subject = "Heures") And _
        (Msg.Attachments.Count >= 1) Then

    'Set folder to save in.
    Dim olDestFldr As Outlook.MAPIFolder
    Dim myAttachments As Outlook.Attachments
    Dim Att As Variant

    Const attPath As String = "C:\Users\NASC02\Test\"

    ' save attachment
    Set myAttachments = item.Attachments
    For Each Att In myAttachments
    Att.SaveAsFile attPath & Att.FileName

Next

    ' mark as read
   Msg.UnRead = False



End If
End If


ProgramExit:
  Exit Sub

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

标签： vbaoutlook

解决方案

编码

Set myAttachments = item.Attachments
Att = myAttachments.item(1).DisplayName
myAttachments.item(1).SaveAsFile attPath & Att

需要改为

Set myAttachments = item.Attachments
for each Att in myAttachments 
    Att.SaveAsFile attPath & Att.FileName
next

推荐阅读