我尝试创建邮件规则,以便将符合特定条件的每封电子邮件中的附件保存到当前文件夹结构中。到目前为止,我只设法添加一个前缀,所以我至少可以在收到它们之前对它们进行排序。
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。
有什么想法吗? THX!
答案 0 :(得分:0)
应该是
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
答案 1 :(得分:0)
文件夹存在的位置。
'saveFolder = "\\server\folder\"
saveFolder = "\\server\folder"
saveFolder = saveFolder & "\" & Format(itm.ReceivedTime, "yyyy") & _
"\" & Format(itm.ReceivedTime, "mm") & _
"\" & Format(itm.ReceivedTime, "dd")