从Excel发送文件夹中的最新文件

Question

I am trying to send the most recent PDF files in a folder from Excel using VBA.

I have managed to do it in Outlook VBA - I am not sure what needs to change to do it in Excel. The reason is because the Outlook macro conflicts with Excel macros that are running periodically.

My code at the moment just attaches all the files in a folder that have been created in the last 30 secs - only ever one PDF.

Please note that the code works perfectly in Outlook.

Sub SendFiles()
 Dim objMail As Outlook.MailItem
 Dim fso As Object
 Dim strFile As String
 Dim fsoFile
 Dim fsoFldr
 Dim dtNew As Date, sNew As String

Set fso = CreateObject("Scripting.FileSystemObject")

 strFile = "C:\temp\" 'path to folder

 Set fsoFldr = fso.GetFolder(strFile)
 dtNew = Now - TimeValue(00:00:30) '30 seconds ago

For Each fsoFile In fsoFldr.Files

If fsoFile.DateCreated > dtNew Then

sNew = fsoFile.Path

Set objMail = Application.CreateItem(olMailItem)

 With objMail
 .To = "email@address.com"
 .Subject = "Example"
 .BodyFormat = olFormatPlain
 .Attachments.Add sNew
 .Importance = olImportanceHigh
 .Send
 End With

End If
Next fsoFile

End Sub

Answer 1

some flaws:

• you're not instantiating any Outlook application object

  in an Excel environment, Application is pointing at Excel Application

• TimeValue(00:00:30) should be TimeValue("00:00:30")

and be sure you have added Outlook library to your VBA project references: 1) click Tools -> References 2) scroll list box till Microsoft Outlook X.XX Object Library entry and toggle its check mark to select it 3) click "OK" button

then you could try this little refactoring of your code:

Option Explicit

Sub SendFiles()
    Dim objOutLook As Object
    Dim fso As Object
    Dim strFile As String
    Dim fsoFile
    Dim fsoFldr
    Dim dtNew As Date, sNew As String
    Dim newOutlookInstance As Boolean

    Set fso = CreateObject("Scripting.FileSystemObject")

    If GetOutlook(objOutLook, newOutlookInstance) Then

        strFile = "C:\temp\" 'path to folder
        Set fsoFldr = fso.GetFolder(strFile)
        dtNew = Now() - TimeValue("00:00:30") '30 seconds ago

        For Each fsoFile In fsoFldr.Files
            If fsoFile.DateCreated > dtNew Then
                sNew = fsoFile.Path
                With objOutLook.CreateItem(olMailItem)
                    .To = "email@address.com"
                    .Subject = "Example"
                    .BodyFormat = olFormatPlain
                    .Attachments.Add sNew
                    .Importance = olImportanceHigh
                    .Send
                End With
            End If
        Next
        If newOutlookInstance Then objOutLook.Quit '<--| quit Outlook if an already running instance of it hasn't been found
        Set objOutLook = Nothing

    Else
        MsgBox "Sorry: couldn't get a valid Outlook instance running"
    End If

End Sub



Function GetOutlook(objOutLook As Object, newOutlookInstance As Boolean) As Boolean
    Set objOutLook = GetObject(, "Outlook.Application")
    If objOutLook Is Nothing Then
        Set objOutLook = New Outlook.Application
        newOutlookInstance = True
    End If
    GetOutlook = Not objOutLook Is Nothing
End Function