使用附件名称保存 Outlook 电子邮件 [英] Save Outlook Emails with Attachment name

问题描述

我需要将大量电子邮件复制到一个文件夹中，但不是使用主题行保存它们，我希望保存的电子邮件的文件名是电子邮件中附件的文件名.

I need to copy a whole lot of e-mails to a folder, but instead of saving them using the subject line I want the file name of the saved e-mail to be that of the attachment in the e-mail.

我目前拥有的是使用主题行保存电子邮件的代码:

All I currently have is the code to save the e-mail using the subject line:

Sub Sample()
    Dim selectedEmail As MailItem
    Dim emailsub As String

    Set selectedEmail = ActiveExplorer.Selection.Item(1)

    attach = GetValidName(selectedEmail.subject)

    'Debug.Print emailsub

    With selectedEmail
        .SaveAs "C:\direcotry\folder\" & attach & ".msg", OlSaveAsType.olMSG
    End With
End Sub

Function GetValidName(sSub As String) As String
    '~~> File Name cannot have these \ / : * ? " < > |
    Dim sTemp As String

    sTemp = sSub

    sTemp = Replace(sTemp, "\", "")
    sTemp = Replace(sTemp, "/", "")
    sTemp = Replace(sTemp, ":", "")
    sTemp = Replace(sTemp, "*", "")
    sTemp = Replace(sTemp, """", "")
    sTemp = Replace(sTemp, "<", "")
    sTemp = Replace(sTemp, ">", "")
    sTemp = Replace(sTemp, "|", "")

    GetValidName = sTemp
End Function

如何确定电子邮件中附件的名称?

How can I determine the name of an attachment in the e-mail?

推荐答案

使用 显示名称属性

Option Explicit
Public Sub SaveAsAttchmentName()
    '//  Declare variables-
    Dim olMail As Outlook.MailItem
    Dim olItem As Object
    Dim sPath As String
    Dim sName As String
    Dim olAtt As Outlook.Attachment

    For Each olItem In ActiveExplorer.Selection
        If olItem.MessageClass = "IPM.Note" Then
            Set olMail = olItem
            For Each olAtt In olMail.Attachments
                '// SaveAs Attachment Name-
                sName = olAtt.DisplayName
                '// Call Function-
                ReplaceCharsForFileName sName, "-"
                sName = sName & ".msg"
                '// SaveAs Path-
                sPath = "C:\temp\"
                olMail.SaveAs sPath & sName, olMsg
            Next
        End If
    Next
End Sub

Private Sub ReplaceCharsForFileName(sName As String, _
  sChr As String _
)
  sName = Replace(sName, "'", sChr)
  sName = Replace(sName, "*", sChr)
  sName = Replace(sName, "/", sChr)
  sName = Replace(sName, "\", sChr)
  sName = Replace(sName, ":", sChr)
  sName = Replace(sName, "?", sChr)
  sName = Replace(sName, Chr(34), sChr)
  sName = Replace(sName, "<", sChr)
  sName = Replace(sName, ">", sChr)
  sName = Replace(sName, "|", sChr)
End Sub

最佳起点是 - Outlook 2010 中的 VBA 入门

代码在 Outlook 2010 上测试

这篇关于使用附件名称保存 Outlook 电子邮件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！