Excelのフォルダに最新のファイルを送信

Question

VBAを使用してExcelからフォルダに最新のPDFファイルを送信しようとしています。

私はOutlook VBAでそれを行うことができました - 私はExcelでそれを行うために何を変更する必要があるのか​​分かりません。理由は、Outlookマクロが定期的に実行されているExcelマクロと競合するためです。

現在、私のコードでは、過去30秒間に作成されたフォルダ内のすべてのファイルが添付されています。

このコードは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

いくつかの欠点：

• あなたはApplicationがあるべきExcelApplication

• TimeValue(00:00:30)を指している、Excelの環境で任意のOutlookアプリケーションオブジェクト

  をインスタンス化していないTimeValue("00:00:30")

OutlookライブラリをVBAプロジェクト参照に追加してください：1）ツール - >参照2）スクロールリストボックスをMicrosoft Outlook X.XXオブジェクトライブラリエントリまでスクロールし、チェックマークをオンにします3 ）

に「OK」ボタンをクリックし、あなたのコードのこの小さなリファクタリング試みることができる：

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