How to show the correct SentOn date in Outlook VBA

feni1388

Board Regular
Joined
Feb 19, 2018
Messages
141
Office Version
  1. 2021
Platform
  1. Windows
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?

VBA Code:
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
 
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. ;)
 
Upvote 0

Forum statistics

Threads
1,226,771
Messages
6,192,918
Members
453,766
Latest member
Gskier

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top