vba - 在 YYYY\MM\DD 文件夹结构下保存邮件附件

Question

我正在尝试创建一个邮件规则，以将满足特定条件的每封电子邮件的附件保存到当前的文件夹结构中。到目前为止，我只设法添加了一个前缀，这样我至少可以按收到它们的日期对它们进行排序。

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "\\server\folder\"
    For Each objAtt In itm.Attachments
    objAtt.SaveAsFile saveFolder & "\" & Format(Date, "yyyymmdd") & "_" & objAtt.DisplayName
    Set objAtt = Nothing
    Next
End Sub

我想扩展“saveFolder”的文件夹结构以包括年/月/日子文件夹，例如。\服务器\文件夹\2018\01\29.

有什么想法吗？谢谢!

Answer 1

应该是

saveFolder = "\\server\folder\" & Format(Now, "yyyymmdd")

You may also wanna check if Folder exists

编辑

完整示例

Option Explicit
Public Sub saveAttachtoDisk(itm As Outlook.mailitem)
    Dim objAtt As Outlook.Attachment
    Dim SaveFolder As String

    SaveFolder = "C:\Temp\" & Year(Date) & "\" & Month(Date) & "\" & Day(Date)

    ' Check for folder and create if needed
    If Len(Dir("C:\Temp\" & Year(Date), vbDirectory)) = 0 Then
        MkDir "C:\Temp\" & Year(Date)
    End If

    If Len(Dir("C:\Temp\" & Year(Date) & "\" & Month(Date), _
                                             vbDirectory)) = 0 Then
        MkDir "C:\Temp\" & Year(Date) & "\" & Month(Date)
    End If

    If Len(Dir("C:\Temp\" & Year(Date) & "\" & Month(Date) & "\" & Day(Date), _
                                                         vbDirectory)) = 0 Then
        MkDir "C:\Temp\" & Year(Date) & "\" & Month(Date) & "\" & Day(Date)
    End If

    For Each objAtt In itm.Attachments
        objAtt.SaveAsFile SaveFolder & "\" & Format(Date, "yyyymmdd") & "_" & _
                                                             objAtt.DisplayName
    Next

    Set objAtt = Nothing
End Sub