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

我想扩展＆＃34; saveFolder＆＃34;的文件夹结构。包括年/月/日子文件夹，例如。 \服务器\文件夹\ 2018 \ 01 \ 29。

有什么想法吗？ THX！

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

Answer 2

文件夹存在的位置。

'saveFolder = "\\server\folder\"
saveFolder = "\\server\folder"
saveFolder = saveFolder & "\" & Format(itm.ReceivedTime, "yyyy") & _
    "\" & Format(itm.ReceivedTime, "mm") & _
    "\" & Format(itm.ReceivedTime, "dd")

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

2 个答案: