從Outlook保存附件與ReceivedTime文件名

Question

我試圖創建一個宏，我可以從電子郵件保存附件。我現在遇到的問題是，我想讓宏在它保存的文件名上添加電子郵件的ReceivedTime（即：文件TESTSHEET.xls在2016-01-01 3:02 AM上收到。我希望保存的文件顯示201601010302AM-TESTSHEET.xls或類似的東西）

這裏是我當前的代碼：

Public itm As Object 

Public Sub saveAttachtoDisk() 
    Dim objAtt As Outlook.Attachment 
    Dim saveFolder As String 
     saveFolder = "C:\Users\Username\Documents\TEST REPORTS" 
     For Each objAtt In itm.Attachments 
     objAtt.SaveAsFile objAtt.DisplayName 
    Next objAtt 
End Sub 

Public Sub SaveAttachments() 
Dim objOL As Outlook.Application 
Dim objMsg As Outlook.MailItem 'Object 
Dim objAttachments As Outlook.Attachments 
Dim objSelection As Outlook.Selection 
Dim objDate As String 
Dim i As Long 
Dim lngCount As Long 
Dim strFile As String 
Dim StrDate As String 
Dim strFolderpath As String 
Dim strDeletedFiles As String 
Set itm = Application.CreateItem(olMailItem) 
Dim CurrentMsg As Outlook.MailItem 


' Get the path to your My Documents folder 
strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16) 
On Error Resume Next 

' Instantiate an Outlook Application object. 
Set objOL = CreateObject("Outlook.Application") 

' Get the collection of selected objects. 
Set objSelection = objOL.ActiveExplorer.Selection 

' Set the Attachment folder. 
strFolderpath = strFolderpath & "\TEST REPORTS\" 

' Check each selected item for attachments. If attachments exist, 
' save them to the strFolderPath folder and strip them from the item. 
For Each objMsg In objSelection 

    ' This code only strips attachments from mail items. 
    ' If objMsg.class=olMail Then 
    ' Get the Attachments collection of the item. 
    Set objAttachments = objMsg.Attachments 
    lngCount = objAttachments.Count 
    strDeletedFiles = "" 

    If lngCount > 0 Then 

     ' We need to use a count down loop for removing items 
     ' from a collection. Otherwise, the loop counter gets 
     ' confused and only every other item is removed. 

     For i = lngCount To 1 Step -1 

      ' Save attachment before deleting from item. 
      ' Get the file name. 
      strFile = objAttachments.Item(i).FileName 

      ' Combine with the path to the Save folder. 
      StrDate = Format(itm.ReceivedTime, "yyyy-mm-dd Hmm ") 
      strFile = strFolderpath & StrDate & strFile 

      ' Save the attachment as a file. 
      MsgBox strFile 
      objAttachments.Item(i).SaveAsFile strFile 

      ' Delete the attachment. 
      objAttachments.Item(i).Delete 

      'write the save as path to a string to add to the message 
      'check for html and use html tags in link 
      If objMsg.BodyFormat <> olFormatHTML Then 
       strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">" 
      Else 
       strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _ 
       strFile & "'>" & strFile & "</a>" 
      End If 

      'Use the MsgBox command to troubleshoot. Remove it from the final code. 
      'MsgBox strDeletedFiles 

     Next i 

     ' Adds the filename string to the message body and save it 
     ' Check for HTML body 
     If objMsg.BodyFormat <> olFormatHTML Then 
      objMsg.Body = vbCrLf & "The file(s) were saved to " & strDeletedFiles & vbCrLf & objMsg.Body 
     Else 
      objMsg.HTMLBody = "<p>" & "The file(s) were saved to " & strDeletedFiles & "</p>" & objMsg.HTMLBody 
     End If 
     objMsg.Save 
    End If 
Next 

ExitSub: 

Set objAttachments = Nothing 
Set objMsg = Nothing 
Set objSelection = Nothing 
Set objOL = Nothing 
End Sub 

預先感謝您的幫助！

Answer 1

使用objMsg不是它。

' StrDate = Format(itm.ReceivedTime, "yyyy-mm-dd Hmm ") 
StrDate = Format(objMsg.ReceivedTime, "yyyy-mm-dd Hmm ") 

另外將其他代碼與新版的ITM和以及objOL

' Set itm = Application.CreateItem(olMailItem) 
' Dim CurrentMsg As Outlook.MailItem 

' On Error Resume Next 
' Instantiate an Outlook Application object. 
' Set objOL = CreateObject("Outlook.Application") 

，直到你知道你在做什麼，不要使用錯誤繼續下一步。