Solved

Word Macro that will email the most recently saved file from a predefined folder to a predefined email address

Posted on 2009-05-10
2
551 Views
Last Modified: 2013-11-10
I would like to have code for a macro that will create an email message to a predefined email address with a predefined subject and message body
and attach to this email the most recently saved Word Document from C:\Test Folder

I already have code for a similar macro which attaches the currently active document to an email message to a predefined email address. I need some modification of it so that instead of attaching the currently active word document, the code attaches the most recently saved word document from the folder (C:\Test Folder)
I include the code (which was very kindly provided by an expert to a related question)

Sub Email()

 

Dim ol As Object 'outlook application object

Set ol = CreateObject("Outlook.Application") 'create an instance of the outlook application

 

Dim olItem As Object 'outlook mail object

Set olItem = ol.CreateItem(0) 'create an instance of an outlook mail object...the 0 indicates you are creating an emial

 

'using the email object

With olItem

    .To = "email@address.com" 'email addressee

    .Subject = "Subject"      'email subject

    .Body = "Message"         'email message

    .Attachments.Add ActiveDocument.FullName 'full path and name of active document to attach to the email

    .Display 'show the email (user need to click the send button)

    '.Send    'sends the email (Outlook security prompt will appear)

End With

 

'clear the outlook mail object

Set olItem = Nothing

'clear the outlook application object

Set ol = Nothing

 

End Sub

Open in new window

0
Comment
Question by:FaheemAhmadGul
2 Comments
 
LVL 92

Accepted Solution

by:
Patrick Matthews earned 500 total points
ID: 24350955
Add the UDF below to your project, then amend your original code to:

Sub Email()
 
Dim ol As Object 'outlook application object
Set ol = CreateObject("Outlook.Application") 'create an instance of the outlook application
 
Dim olItem As Object 'outlook mail object
Set olItem = ol.CreateItem(0) 'create an instance of an outlook mail object...the 0 indicates you are creating an emial
 
'using the email object
With olItem
    .To = "email@address.com" 'email addressee
    .Subject = "Subject"      'email subject
    .Body = "Message"         'email message
    .Attachments.Add FileByDate("c:\test folder", "DateLastModified", "newest", "path", ".doc*")
    .Display 'show the email (user need to click the send button)
    '.Send    'sends the email (Outlook security prompt will appear)
End With
 
'clear the outlook mail object
Set olItem = Nothing
'clear the outlook application object
Set ol = Nothing
 
End Sub
Function FileByDate(LookInDir As String, DateParam As Variant, DateSort As Variant, _
    ReturnType As Variant, ParamArray Extensions())
    
    ' Function by Patrick Matthews
    '
    ' Function looks in specified directory, and depending on the arguments selected returns
    ' the file name and path for the oldest/newest file in that folder, or the date associated
    ' with that file. Function can use DateCreated, DateLastAccessed, or DateLastModified to
    ' determine oldest/newst.
    '
    ' Arguments:
    '
    ' LookInDir: the folder you want to analyze.  This function does NOT look in "descendant"
    '   subfolders
    '
    ' DateParam: indicates whether to use "DateCreated" (1), "DateLastAccessed" (2), or
    '   DateLastModified (3).  You may use the ordinal above or the name of the property as a
    '   string
    '
    ' DateSort: indicates whether to use "oldest" (1) or "newest" (2) date.  You may use
    '   ordinal or the string
    '
    ' ReturnType: indicates whether to return "name"/"path"/"filename" (1) or "date" (2).
    '   You may use ordinal or the string
    '
    ' Extensions: list of 1 - 32 "extensions" you want to use for a match for file types.  For
    '   example, "xls" will match all *.xls files.  You may use wild cards in the extension list.
    '   Note that these are not necessarily limited to true "extensions"--for example, you could
    '   use "main.mdb" to match all files ending in "main.mdb"
    '
    ' If no files match the arguments function returns zero length string
    
    Dim fso As Object 'Scripting.FileSystemObject
    Dim fld As Object 'Scripting.Folder
    Dim fil As Object 'Scripting.File
    Dim TestDate As Date
    Dim CurrentDate As Date
    Dim NameAndPath As String
    Dim Ext As Variant
    
    Const HighDate As Date = #12/31/2999#
    Const LowDate As Date = #1/1/1900#
    
    ' Set to lower case to make string comparisons easier, if applicable
    
    If Not IsNumeric(DateParam) Then DateParam = LCase(DateParam)
    If Not IsNumeric(DateSort) Then DateSort = LCase(DateSort)
    If Not IsNumeric(ReturnType) Then ReturnType = LCase(ReturnType)
    
    ' Set defaults for test date
    
    Select Case DateSort
        Case 1, "first", "oldest"
            TestDate = HighDate
            DateSort = 1
        Case 2, "last", "newest"
            TestDate = LowDate
            DateSort = 2
        Case Else:
            FileByDate = ""
            GoTo Cleanup
    End Select
    
    ' Validate that there is at least one extension to test
    
    If UBound(Extensions) = -1 Then
        FileByDate = ""
        GoTo Cleanup
    End If
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(LookInDir)
    
    ' Loop through files in folder
    
    For Each fil In fld.Files
        
        ' Check file name against each extension in the list
        
        For Each Ext In Extensions
            If LCase(fil.Path) Like "*" & LCase(Ext) Then
                
                ' Grab appropriate date based on DateParam argument
                
                Select Case DateParam
                    Case 1, "datecreated": CurrentDate = fil.DateCreated
                    Case 2, "datelastaccessed": CurrentDate = fil.DateLastAccessed
                    Case 3, "datelastmodified": CurrentDate = fil.DateLastModified
                    Case Else
                        FileByDate = ""
                        GoTo Cleanup
                End Select
                
                ' Check to see whether CurrentDate "beats" the current TestDate
                
                If DateSort = 1 Then
                    If CurrentDate < TestDate Then
                        TestDate = CurrentDate
                        NameAndPath = fil.Path
                    End If
                Else
                    If CurrentDate > TestDate Then
                        TestDate = CurrentDate
                        NameAndPath = fil.Path
                    End If
                End If
                
                ' No need to test the other extensions once we find one that works!
                
                Exit For
            End If
        Next
    Next
    
    If NameAndPath <> "" Then
        
        ' Determine return value of function
        
        Select Case ReturnType
            Case 1, "name", "path", "filename": FileByDate = NameAndPath
            Case 2, "date": FileByDate = TestDate
            Case Else: FileByDate = ""
        End Select
    End If
    
Cleanup:
    
    ' Release object variables
    
    Set fil = Nothing
    Set fld = Nothing
    Set fso = Nothing
    
End Function

Open in new window

0
 

Author Closing Comment

by:FaheemAhmadGul
ID: 31579918
This has worked perfectly. Many thanks. I am extremely grateful. Regards. Faheem
0

Featured Post

Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

Join & Write a Comment

Suggested Solutions

Does the idea of dealing with bits scare or confuse you? Does it seem like a waste of time in an age where we all have terabytes of storage? If so, you're missing out on one of the core tools in every professional programmer's toolbox. Learn how to …
If you’re thinking to yourself “That description sounds a lot like two people doing the work that one could accomplish,” you’re not alone.
This video walks the viewer through the process of creating envelopes and labels, with multiple names and addresses. Navigate to the “Start Mail Merge” button in the Mailings tab: Follow the step-by-step process until asked to find the address doc…
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now