How to show the correct SentOn date in Outlook VBA

[feni1388]

Hello everyone...

I found this macro in the internet (creation of Diane Poremsky) and use it to automatically save messages that come in a certain folder to my hard drive.
It works perfectly except for the date.
I don't know why it doesn't show the correct date but instead it showed random number (I don't know what number it is).
Can anyone help?

Option Explicit

Private WithEvents olInboxItems As Items
 
Private Sub Application_Startup()
  Dim objNS As NameSpace
  Set objNS = Application.Session
  ' instantiate objects declared WithEvents
  Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Folders("MD").Items
  Set objNS = Nothing
End Sub
 
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim dtDate As Date
Dim sName As String
Dim objMsg As Outlook.MailItem 'Object

Dim objAttachments As Outlook.Attachments
Dim lngCount As Long


Dim strFolderpath As String
Dim strFile As String
Dim sFileType As String
Dim i As Long
 
  On Error Resume Next
 
Set objAttachments = Item.Attachments
    lngCount = objAttachments.Count
 

If Item.Attachments.Count > 0 Then
 
dtDate = objMsg.SentOn

         sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, vbUseSystem) & "_"


 For i = lngCount To 1 Step -1


' Get the file name.
 'strFile = objAttachments.Item(i).FileName
 strFile = sName & objAttachments.Item(i).FileName

 ' Get the path to your My Documents folder
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    
    strFolderpath = strFolderpath & "\OLAttachments\"


    ' This code looks at the last 4 characters in a filename
      sFileType = LCase$(Right$(strFile, 4))
 
      Select Case sFileType
      
 ' Add additional file types below
       Case ".xls", "xlsx", ".pdf"
        strFile = strFolderpath & strFile
       objAttachments.Item(i).SaveAsFile strFile
      
      End Select




'' Combine with the path to the folder.
' strFile = strFolderpath & strFile
'
'' Save the attachment as a file.
' objAttachments.Item(i).SaveAsFile strFile

 Next i
End If

End Sub

 

[John_w]

Try replacing:

dtDate = objMsg.SentOn

with:

dtDate = Item.SentOn

 

[RoryA]

A good lesson in why you shouldn't just stick On Error Resume Next at the top of a routine and hope for the best.

 

[feni1388]

Try replacing:

dtDate = objMsg.SentOn

with:

dtDate = Item.SentOn

Thanks a lot.
It worked......