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
561 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
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
 
LVL 1

Author Closing Comment

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

Featured Post

SharePoint Admin?

Enable Your Employees To Focus On The Core With Intuitive Onscreen Guidance That is With You At The Moment of Need.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Computer science students often experience many of the same frustrations when going through their engineering courses. This article presents seven tips I found useful when completing a bachelors and masters degree in computing which I believe may he…
Q&A with Course Creator, Mark Lassoff, on the importance of HTML5 in the career of a modern-day developer.
This video shows where to find templates, what they are used for, and how to create and save a custom template using Microsoft Word.
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses

624 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