如何将带有日期戳的特定附件从 Outlook 收件箱保存到特定文件夹？

Question

每天早上我都会收到一封包含 3 个文件的电子邮件：

"Daily MILH Checks e.xls"
"Daily Unit Linked .pdf"
"Daily Unit Linked.xls"

那是 2x .xls 和一个 PDF。文件名永远不会改变。

该电子邮件来自如下主题行："[email protected]"

"IA083A - (Date: May 23, 2016)"

我创建了一条规则，每次收到主题行中的电子邮件时都会运行一个宏。"[email protected]""IA083A"

我知道发布的代码这里是我所需要的起点。

Public Sub SaveToDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat

dateFormat = Format(Now, "yyyy-mm-dd")

'Change this path to the your folder location
saveFolder = "c:\temp\"

objAtt.SaveAsFile saveFolder & "\" & dateFormat & ".xls"

Set objAtt = Nothing

End Sub

上面没有区分不同的文件。我的 3 个文件都需要分别保存到单独的文件夹位置。

上述操作在保存之前将文件重命名为“yyyy-mm-dd”。我希望它保留文件名称的一部分并在末尾添加日期。例如“检查报告 23-05-2016”

Answer 1

您引用的另一篇文章链接至像素厨师它具有将每个文件保存到其各自文件夹并使用日期戳所需的所有元素。

Answer 2

您可以编写一个 bat 文件来将这些附件从保存的路径移动到目标位置。您可以从上面的代码中调用该 bat 文件。

Answer 3

Option Explicit


Sub SaveToDisk_MultipleFolders(itm As Object)

Dim objAtt As Attachment

Dim saveFolder As String
Dim saveFileName As String

Dim dateFormat As String

Dim posDot As Long
Dim fNameNoExt As String
Dim fExt As String

If TypeOf itm Is MailItem Then

    dateFormat = Format(Now, "yyyy-mm-dd")

    For Each objAtt In itm.Attachments
        
        Debug.Print
        Debug.Print "objAtt.DisplayName: " & objAtt.DisplayName
        
        saveFolder = ""
        
        If InStr(objAtt.DisplayName, "Daily MILH Checks.xls") Then
            saveFolder = "c:\MILHChecks\"
                
        ElseIf InStr(objAtt.DisplayName, "Daily Unit Linked.pdf") Then
            saveFolder = "c:\UnitLinkedPDF\"
            
        ElseIf InStr(objAtt.DisplayName, "Daily Unit Linked.xls") Then
            saveFolder = "c:\UnitLinkedXLS\"
            
        End If
        
        If saveFolder <> "" Then
        
            If Right(saveFolder, 1) <> "\" Then
                saveFolder = saveFolder & "\"
            End If
            Debug.Print " saveFolder: " & saveFolder
                
            posDot = InStrRev(objAtt.DisplayName, ".")
            Debug.Print " posDot: " & posDot
                
            fNameNoExt = Left(objAtt.DisplayName, posDot - 1)
            Debug.Print " fNameNoExt: " & fNameNoExt
            
            fExt = Right(objAtt.DisplayName, Len(objAtt.DisplayName) - posDot + 1)
            Debug.Print " fExt: " & fExt
            
            saveFileName = fNameNoExt & "_" & dateFormat & fExt
            
            Debug.Print " saveFileName: " & saveFileName
            objAtt.SaveAsFile saveFolder & saveFileName
                
            Set objAtt = Nothing
            
        Else
            
            Debug.Print "saveFolder error: " & objAtt.DisplayName
        
        End If
        
    Next
    
End If

End Sub


Private Sub test()
    SaveToDisk_MultipleFolders ActiveInspector.CurrentItem
End Sub