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

我正尝试使用VBA从Excel中发送文件夹中最近的PDF文件。

我设法在Outlook VBA中做到这一点 – 我不知道什么需要改变,在Excel中做到这一点。 原因是因为Outlookmacros与定期运行的Excelmacros冲突。

我目前的代码只是附加在过去30秒内创build的文件夹中的所有文件 – 只有一个PDF。

请注意,该代码在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 

一些缺陷:

  • 你没有实例化任何Outlook应用程序对象

    在Excel环境中, Application指向Excel Application

  • TimeValue(00:00:30)应该是TimeValue("00:00:30")

并确保你已经添加到您的VBA项目引用的Outlook库:1)单击工具 – >参考2)滚动列表框,直到Microsoft Outlook X.XX对象库条目,并切换其复选标记select它3)点击“确定”button

那么你可以尝试你的代码的这个小重构:

 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