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?
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