Click here to Skip to main content
15,885,366 members
Please Sign up or sign in to vote.
0.00/5 (No votes)
See more:
I have created a VBA script that will automatically save pdf attachments. Does anyone here know how can I save the attachment based on the date? For Example, today is 02-04-2020 then this specific user emailed me with an pdf attachment then automatically a folder will be created with the name 02-04-2020 and all mail for that day will be stored in that folder. Then on next day another folder will be created. I really need to separate the incoming attachments by date.

What I have tried:

Here is what I have so far

VB
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim dateFormat
dateFormat = Format(Now, "yyyy-mm-dd H-mm")
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim getsender As String
saveFolder = "C:\Users\UserName\Desktop\Attachments\"
     For Each objAtt In itm.Attachments
          If InStr(objAtt.FileName, ".pdf") > 0 Then
          objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
          Set objAtt = Nothing
          End If
     Next
End Sub
Posted
Updated 3-Feb-20 21:52pm

1 solution

You can use the Folders.Add method [^] method to create the folders either based on Now or on Outlook.MailItem.CreationDate (the latter might be useful if you want to retrospectively move stuff)

If I've misunderstood, and it's a folder on your C: drive you want to create then you can use the MkDir statement[^]

Edit: Other functions you might find useful
FolderExists method [^]
Folders object (Outlook) [^]

Edit - some actual code
VB
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim dateFormat As String    'Comment 1

    'dateFormat = Format(Now, "yyyy-mm-dd H-mm")
    dateFormat = Format(itm.CreationTime, "yyyy-mm-dd") 'Comment 2

    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim getsender As String

    saveFolder = "C:\Users\UserName\Desktop\Attachments\" & dateFormat & "\" 'Comment 3
    
    CreateFolderIfNotExists saveFolder  'Comment 4
    
    For Each objAtt In itm.Attachments
        If InStr(objAtt.FileName, ".pdf") > 0 Then
            objAtt.SaveAsFile saveFolder & objAtt.DisplayName
        End If
        'Set objAtt = Nothing   'Comment 5
     Next
End Sub


Public Sub CreateFolderIfNotExists(folderName As String)
    'Parameter folderName must be a fully qualifed path including drive
    'All errors are assumed to be handled by the calling code
    
    Dim fs As Object 'Using late binding to avoid having to include a reference to Microsoft Scripting Runtime
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    If Not fs.folderexists(folderName) Then
        fs.createfolder (folderName)    'Comment 6
    End If
End Sub
Points to note - see the comment points in the code:
Comment 1:
I've explicitly given dateFormat a type. I believe that to be best practice

Comment 2:
I've used the date that the email was created - this will allow you to retrospectively save attachments for older emails in the correct folders. Note the difference in the format I have used compared to yours.

Comment 3:
I've added the appropriate date to the saveFolder name

Comment 4:
I've put the code to check for a folder and create it into a separate subroutine

Comment 5:
There is no need to set objAtt to Nothing after saving the PDF. It will be reassigned by the loop immediately afterwards. You exit the sub after the loop is complete so it will go out of scope and eventually be cleared out of memory anyway.

Comment 6:
I suggested using MkDir in my original answer, but I already have a FileSystemObject so I've used CreateFolder instead here.

Another Edit!

Here is a snippet of code that will get all items in your inbox and dump the sender details to the Immediate window
VB
Dim objMails As Outlook.Items
Set objMails = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
Dim objMail As Outlook.MailItem
For Each objMail In objMails
    Debug.Print objMail.Sender, objMail.SenderEmailAddress
Next
 
Share this answer
 
v4
Comments
cristian frias 4-Feb-20 3:58am    
@CHill60 Hi sorry I am just a newbie in VBA scripting. Would you mind to provide a sample code? What I am trying to do is if a specific user send an email then the attachment will be automatically save based on a folder that folder has a folder name of specific date. And if the folder already exist the attachment will be save on the existing folder.
cristian frias 4-Feb-20 4:00am    
Also I want to create a folder on my drive.
cristian frias 4-Feb-20 21:54pm    
@CHill60 Thank you so much for a quick answer. Your code works well. Thank you so much for saving me. =) God bless always.
CHill60 5-Feb-20 3:49am    
My pleasure!
cristian frias 23-Feb-20 21:37pm    
Hi @CHill60 I just tested the script in multiple pc and email accounts just happened to encounter an scenario where there is another rule from the account which is to automatically moved the email message to separate folder since the message is moved auto saving is not working. Do you have any idea? Thank you so much.

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)



CodeProject, 20 Bay Street, 11th Floor Toronto, Ontario, Canada M5J 2N8 +1 (416) 849-8900