Reputation: 49
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 protected]"
.Subject = "Example"
.BodyFormat = olFormatPlain
.Attachments.Add sNew
.Importance = olImportanceHigh
.Send
End With
End If
Next fsoFile
End Sub
Upvotes: 0
Views: 2040
Reputation: 29421
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 protected]"
.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
Upvotes: 1