将电子邮件附件保存在指定的文件夹中,文件消失

时间:2018-07-16 23:13:33

标签: email outlook attachment

因此,我正在尝试制作一种从特定文件夹接收电子邮件并将附件保存在特定文件夹中的工具。我从上一篇文章中获取了这段代码,并针对我的目的对其进行了重新设计。它可以正常运行,但不会将文件保存在指定的文件夹中,因此我终生无法弄清楚。谁能看到我的错误?

Sub ExtractFirstUnreadEmailDetails()
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object, Br As Object
    Dim oOlAtch As Object
    Dim eSender As String, dtRecvd As String, dtSent As String
    Dim sSubj As String, sMsg As String



'~~> Get Outlook instance
Set oOlAp = GetObject(, "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)
Set Br = oOlInb.Folders("Brokers")

'~~> Store the relevant info in the variables
For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
    eSender = oOlItm.SenderEmailAddress
    dtRecvd = oOlItm.ReceivedTime
    dtSent = oOlItm.CreationTime
    sSubj = oOlItm.Subject
    sMsg = oOlItm.Body


    Exit For
Next



Const AttachmentPath As String = "C:\Desktop\Test"



'~~> New File Name for the attachment
Dim NewFileName As String
NewFileName = AttachmentPath & Format(Date, "DD-MM-YYYY") & "-"
'NewFileName = oOlItm.Subject & Format(Date, "DD-MM-YYYY") & "-"

'~~> Extract the attachment from the 1st unread email
For Each oOlItm In Br.Items
    For Each oOlAtch In oOlItm.Attachments
            Subject = "Test"
            NewFileName = Subject
            oOlAtch.SaveAsFile NewFileName & oOlAtch.Filename

        Next
    Exit For
Next
End Sub

如果有人可以指出任何事情,我将非常感激。谢谢!

1 个答案:

答案 0 :(得分:0)

随机选择一条路径是通往失败的道路。

文件应保存在您在C:\ Desktop中创建的名为Test的文件夹中

Option Explicit

Sub ExtractFirstUnreadEmailDetails()

    ' Set up for Outlook
    '   not for other applications to use Outlook VBA code
    Dim oOlInb As Folder
    Dim Br As Folder

    Dim oOlItm As Object
    Dim oOlAtch As attachment

    Dim Subject As String

    '~~> Get Inbox of Outlook
    Set oOlInb = Session.GetDefaultFolder(olFolderInbox)

    Set Br = oOlInb.Folders("Brokers")

    Const AttachmentPath As String = "C:\Desktop\Test"

    '~~> New File Name for the attachment
    Dim NewFileName As String

    '~~> Extract the attachment from the 1st unread email
    For Each oOlItm In Br.Items

        For Each oOlAtch In oOlItm.Attachments

            Subject = "Test"

            ' Note the often forgotten path separator
            NewFileName = AttachmentPath & "\" & Subject & Format(Date, "DD-MM-YYYY") & "-" & oOlAtch.fileName

            ' C:\Desktop\Test\Test17-07-2018-fileName
            Debug.Print NewFileName

            oOlAtch.SaveAsFile NewFileName

        Next

        Exit For

    Next

End Sub

结果应该是一个名为C:\ Desktop \ Test文件夹中的文件Test17-07-2018-Filename

相关问题