仅将多个电子邮件附件保存为当前日期

时间:2018-09-17 11:51:42

标签: excel-vba

我是VBA的新手。我准备了一个代码来仅下载当前日期的多个电子邮件的附件,但是只要执行此宏,它就会给我:

  

自动化错误,系统找不到指定的路径

有人可以查看下面粘贴的代码并为我提供帮助。谢谢

Sub Outlook_Attachments()

Dim OLOOK As Outlook.Application
Dim OMAIL As Outlook.MailItem
Dim ONS As Outlook.Namespace
Dim FOL As Outlook.Folder
Dim SFOLDER As String
Dim FNAME As String
Set OLOOK = New Outlook.Application
Set OMAIL = OLOOK.CreateItem(olMailItem)
Set ONS = OLOOK.GetNamespace("MAPI")
Set FOL = ONS.GetDefaultFolder(olFolderInbox).Folders("Test")
SFOLDER = "D:\"
FNAME = SFOLDER & Format(Date, "MM/DD/YYYY") & "*"  
For Each OMAIL In FOL.Items
    For Each ATMT In OMAIL.Attachments
        ATMT.SaveAsFile FNAME & ATMT.DisplayName
    Next
Next
End Sub

1 个答案:

答案 0 :(得分:2)

尝试一下:

 Sub Outlook_Attachments()

Dim OLOOK As Outlook.Application
Dim OMAIL As Outlook.MailItem
Dim ONS As Outlook.Namespace
Dim FOL As Outlook.Folder
Dim SFOLDER As String
Dim FNAME As String
Set OLOOK = New Outlook.Application
Set OMAIL = OLOOK.CreateItem(olMailItem)
Set ONS = OLOOK.GetNamespace("MAPI")
Set FOL = ONS.GetDefaultFolder(olFolderInbox).Folders("Test")
SFOLDER = "D:\"
FNAME = SFOLDER & Format(Date, "MM-DD-YYYY") & "-"

For Each OMAIL In FOL.Items
    'check email recevied date
    If Format(OMAIL.ReceivedTime, "MM-DD-YYYY") = Format(Date, "MM-DD-YYYY") Then
        For Each ATMT In OMAIL.Attachments
            ATMT.SaveAsFile FNAME & ATMT.DisplayName
        Next
    End If
Next

结束子

禁止在文件/文件夹名称中使用'/'和'*'。