时间戳

首页 > 解决方案 > 如何自动保存来自特定发件人的附件？

vba - 如何自动保存来自特定发件人的附件？

问题描述

我想自动将来自特定发件人的附件保存在预定文件夹中。

Public WithEvents objInboxItems As Outlook.Items

Private Sub Application_Startup()
   Set objInboxItems = Session.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
   Dim objMail As Outlook.MailItem
   Dim strSenderAddress As String
   Dim strSenderDomain As String
   Dim objAttachment As Attachment
   Dim strFolderPath As String
   Dim strFileName As String

   If Item.Class = olMail Then
      Set objMail = Item

      'Get sender domain
      strSenderAddress = objMail.SenderEmailAddress
      'strSenderDomain = Right(strSenderAddress, Len(strSenderAddress) - InStr(strSenderAddress, "@"))

      'Change to the specific domain as per your needs
      If strSenderAddress = "Da.Te@union.de" Then
         If objMail.Attachments.Count > 0 Then
            For Each objAttachment In objMail.Attachments
                'Change the folder path where you want to save attachments
                strFolderPath = "U:\Test"
                strFileName = objMail.Subject & " " & Chr(45) & " " & objAttachment.FileName
                objAttachment.SaveAsFile strFolderPath & strFileName
            Next
         End If
      End If
   End If
End Sub

此代码来自此处，稍作修改。

标签： vbaoutlookoutlook-filter

解决方案

我认为您发布的代码没有任何问题，我也希望使用该代码，但不是按域过滤，而是按特定发件人过滤。我根据自己的需要稍微调整了代码，并通过将需要修改的 3 个字段移到顶部来更轻松地为新用户进行调整。我还注释掉了保存以“主题 - 附件名称”为前缀的附件的部分，因此它纯粹将其保存为“附件名称”。

我的问题是我没有在信任中心启用宏，我把它放在一个单独的模块中，但它必须在“ThisOutlookSession”下。

我还添加了一行以在保存附件后删除邮件。

在此处输入图像描述

Public WithEvents objInboxItems As Outlook.Items

Private Sub Application_Startup()
   Set objInboxItems = Session.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
   Dim objMail As Outlook.MailItem
   Dim strSenderAddress As String
   Dim strSenderDomain As String
   Dim objAttachment As Attachment
   Dim strFolderPath As String
   Dim strFileName As String
   Dim strDesiredSender As String
   Dim strDesiredDomain As String

   strFolderPath = Environ("USERPROFILE") & "\Documents\"
   'strDesiredDomain = "gmail.com"
   strDesiredSender = "user@gmail.com"

   If Item.Class = olMail Then
      Set objMail = Item

      'Get sender domain
      strSenderAddress = objMail.SenderEmailAddress
      strSenderDomain = Right(strSenderAddress, Len(strSenderAddress) - InStr(strSenderAddress, "@"))

      'Use either strSenderDomain or strSenderAddress Depending on Filter Desired
      'If strSenderDomain = strDesiredDomain Then
      If strSenderAddress = strDesiredSender Then
         If objMail.Attachments.Count > 0 Then
            For Each objAttachment In objMail.Attachments
                ''''Save in format "Subject - Attachmentname"
                'strFileName = objMail.Subject & " " & Chr(45) & " " & objAttachment.FileName
                'objAttachment.SaveAsFile strFolderPath & strFileName 
                ''''Save in format exactly as attachment name
                objAttachment.SaveAsFile strFolderPath & objAttachment.FileName 
                objMail.Delete 'Delete after saving attachment
            Next
         End If
      End If
   End If
End Sub

推荐阅读