☰

如何按公司名称的字母顺序对 Outlook 中的数百封电子邮件进行排序？

tag-icon • tag-icon microsoft-outlook vba attachments
如何按公司名称的字母顺序对 Outlook 中的数百封电子邮件进行排序？

首先，我有 Windows 11，我的 Microsoft Outlook 版本是 2010。

我是公司的应付账款文员。我最近开始无纸化办公，并试图找到一些快捷方式来整理我通过电子邮件以 pdf 格式发送给我的收据。然后我将 pdf 保存到文件夹中，以便稍后进行分类和处理。

我花费了大量时间保存每个单独的文件，然后将它们移动到子文件夹 A、B、C……等等。

我知道如何将所有附件保存在一封电子邮件中。而且我知道如何使用 VBA（某种程度上）选择多封电子邮件并在 Outlook 中运行宏以将选定电子邮件中的每个附件保存到我的文件夹中。但我仍然必须将它们分类到子文件夹中。我正在尝试找到一种方法来按公司对收件箱中的电子邮件进行排序，这样我就可以先进行排序，然后只选择以 A 开头的公司，运行我的脚本，然后一次性将所有附件移动到 A 文件夹。实际上，我很想找到一种方法来设置它，以便我可以运行一个脚本，将附件从特定电子邮件发送到特定文件夹。例如...“此电子邮件”中的附件保存到“此文件夹”。

我通常每周下载发票，因此我有数百张发票。到目前为止，我能做的最好的事情就是一次性保存所有发票，但之后我仍然需要打开每张发票进行排序。有些发票我可以通过文件名知道是什么，但不是全部。

首先对电子邮件进行分类并不容易，有些电子邮件会有个人姓名，有些会有公司姓名，有些会显示“无回复等”。

这是脚本，它允许我选择很多封电子邮件并保存下面的所有附件。是否可以以某种方式编辑它？我可以运行一个脚本或规则，一次选择一百封电子邮件，然后来自某些供应商的所有发票都会转到该供应商文件夹吗？或者，我如何编辑/格式化收到的电子邮件，以便我可以按字母顺序排序，然后逐个字母下载？我曾考虑过制定分类规则，但我仍然必须一次运行一个字母的脚本。我很想听听一些想法。并感谢任何反馈！我每周大概会收到 200-300 封电子邮件，有些电子邮件有一个附件，有些有很多附件，但有一些供应商我会定期收到很多发票。谢谢！

Dim GCount As Integer
Dim GFilepath As String
Public Sub SaveAttachments()
'Update 20200821
Dim xMailItem As Outlook.MailItem
Dim xAttachments As Outlook.Attachments
Dim xSelection As Outlook.Selection
Dim i As Long
Dim xAttCount As Long
Dim xFilePath As String, xFolderPath As String, xSaveFiles As String
On Error Resume Next
xFolderPath = CreateObject("WScript.Shell").SpecialFolders(16)
Set xSelection = Outlook.Application.ActiveExplorer.Selection
xFolderPath = xFolderPath & "\Attachments\"
If VBA.Dir(xFolderPath, vbDirectory) = vbNullString Then
    VBA.MkDir xFolderPath
End If
GFilepath = ""
For Each xMailItem In xSelection
    Set xAttachments = xMailItem.Attachments
    xAttCount = xAttachments.Count
    xSaveFiles = ""
    If xAttCount > 0 Then
        For i = xAttCount To 1 Step -1
            GCount = 0
            xFilePath = xFolderPath & xAttachments.Item(i).FileName
            GFilepath = xFilePath
            xFilePath = FileRename(xFilePath)
            If IsEmbeddedAttachment(xAttachments.Item(i)) = False Then
                xAttachments.Item(i).SaveAsFile xFilePath
                If xMailItem.BodyFormat <> olFormatHTML Then
                    xSaveFiles = xSaveFiles & vbCrLf & "<Error! Hyperlink reference not valid.>"
                Else
                    xSaveFiles = xSaveFiles & "<br>" & "<a href='file://" & xFilePath & "'>" & xFilePath & "</a>"
                End If
            End If
        Next i
    End If
Next
Set xAttachments = Nothing
Set xMailItem = Nothing
Set xSelection = Nothing
End Sub

Function FileRename(FilePath As String) As String
Dim xPath As String
Dim xFso As FileSystemObject
On Error Resume Next
Set xFso = CreateObject("Scripting.FileSystemObject")
xPath = FilePath
FileRename = xPath
If xFso.FileExists(xPath) Then
    GCount = GCount + 1
    xPath = xFso.GetParentFolderName(GFilepath) & "\" & xFso.GetBaseName(GFilepath) & " " & GCount & "." + xFso.GetExtensionName(GFilepath)
    FileRename = FileRename(xPath)
End If
xFso = Nothing
End Function

Function IsEmbeddedAttachment(Attach As Attachment)
Dim xItem As MailItem
Dim xCid As String
Dim xID As String
Dim xHtml As String
On Error Resume Next
IsEmbeddedAttachment = False
Set xItem = Attach.Parent
If xItem.BodyFormat <> olFormatHTML Then Exit Function
xCid = ""
xCid = Attach.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001F")
If xCid <> "" Then
    xHtml = xItem.HTMLBody
    xID = "cid:" & xCid
    If InStr(xHtml, xID) > 0 Then
        IsEmbeddedAttachment = True
    End If
End If
End Function

相关内容