使用发件人名称保存附件,然后保存到文件夹并重命名

时间:2015-03-25 20:01:46

标签: vba outlook outlook-vba

我有这个宏来使用发件人名称保存电子邮件附件。但是,它不起作用。你能救我吗?

Public Sub saveattachment(email As Outlook.MailItem)
    Dim anexo As Outlook.Attachment
    Dim caminho As String
    Dim mes As String
    Dim ano As String
    Dim dataRena As String
    Dim dataRena2 As String
    Dim dataCall As String

    'let´s find which month, mmmm, to save the workbook
    Month = "March"
    Year = CStr(Year(Date))

    'save email using sendername
    Select Case email.SenderName
    Case "Adam Smith"
        caminho = "C:\Users\Barack.Obama\Desktop"
        For Each anexo In email.Attachments
            If Right(anexo.DisplayName, Len(anexo.DisplayName) - _
                InStrRev(anexo.DisplayName, ".")) = "xls" Then
                anexo.SaveAsFile (caminho & "\" & "Obama.xls")
            ElseIf Right(anexo.DisplayName, Len(anexo.DisplayName) - _
            InStrRev(anexo.DisplayName, ".")) = "xlsx" Then
                anexo.SaveAsFile (caminho & "\" & "Obama.xlsx")
            End If
            Set anexo = Nothing
        Next
    End Select
End Sub

1 个答案:

答案 0 :(得分:0)

我注意到以下代码:

    For Each anexo In email.Attachments
        If Right(anexo.DisplayName, Len(anexo.DisplayName) - _
            InStrRev(anexo.DisplayName, ".")) = "xls" Then
            anexo.SaveAsFile (caminho & "\" & "Obama.xls")
        ElseIf Right(anexo.DisplayName, Len(anexo.DisplayName) - _
        InStrRev(anexo.DisplayName, ".")) = "xlsx" Then
            anexo.SaveAsFile (caminho & "\" & "Obama.xlsx")
        End If
        Set anexo = Nothing
    Next

事实是,如果集合中有多个附件,它们可能会在磁盘上相互覆盖,因为您保存了具有相同名称的文件。请尝试使用单个文件名:

     For Each anexo In email.Attachments
        If Right(anexo.DisplayName, Len(anexo.DisplayName) - _
            InStrRev(anexo.DisplayName, ".")) = "xls" Then
            anexo.SaveAsFile (caminho & "\" & anexo.Index & "Obama.xls")
        ElseIf Right(anexo.DisplayName, Len(anexo.DisplayName) - _
        InStrRev(anexo.DisplayName, ".")) = "xlsx" Then
            anexo.SaveAsFile (caminho & "\" & anexo.Index & "Obama.xlsx")
        End If
        Set anexo = Nothing
    Next

因此,每个附件都有唯一的名称。

另外,我建议为每封电子邮件创建一个文件夹。