VBAスクリプトをトリガーする電子メールを選択

Question

私は特定の送信者から添付ファイルを自動的に選択してダウンロードするOutlookスクリプトを作成しています。現在、レポートはデータベース上で生成され、指定されたアドレスに電子メールで送信されます。次のステップは、これらのレポートを指定されたフォルダに自動的にダウンロードすることです。現在、指定された送信者から電子メールが届いた場合、スクリプトは現在選択されている電子メールから電子メールをダウンロードし、スクリプトをトリガーする送信者から電子メールを選択するようにスクリプトを作成する必要があります。

私はVBAにとって非常に新しく、どんな助けでも大歓迎です。

Public Sub SaveAttachments(Item As Outlook.MailItem) 
Dim objOL As Outlook.Application 
Dim objMsg As Outlook.MailItem 'Object 
Dim objAttachments As Outlook.Attachments 
Dim objSelection As Outlook.Selection 
Dim i As Long 
Dim lngCount As Long 
Dim strFile As String 
Dim strFolderpath As String 
Dim strDeletedFiles As String 

'Get the path to the target folder 
strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16) 
On Error Resume Next 

'Instantiate an Outlook Application Object 
Set objOL = CreateObject("Outlook.Application") 

'Get the collection of selected objects 
Set objSelection = objOL.ActiveExplorer.Selection 

'Set the Attachment folder 
strFolderpath = strFolderpath & "\Attachments\" 

'Check each selected item for attachements. If attachments exist, save them 
'to the strFOlderPath folder and strip them from the item. 
For Each objMsg In objSelection 

'This code only strips attachments from mail items. 
'If objMsg.class=olMail Then 
'Get the Attachments collection of the item 
Set objAttachments = objMsg.Attachments 
lngCount = objAttachments.Count 
strDeletedFile = "" 

If lngCount > 0 Then 

    'A count down loop needs to be used for removing items 
    'from a collection. Otherwise the loop counter gets 
    'confused and only every other item is removed 

    For i = lngCount To 1 Step -1 

     'Save attachment before deleting from item. 
     'Get the file name 
     strFile = objAttachments.Item(i).FileName 

     'Combine with the path to the Temp folder. 
     strFile = strFolderpath & strFile 

     'Save the attachment as a file 
     objAttachments.Item(i).SaveAsFile strFile 

     'Delete the attachment 
     objAttachments.Item(i).Delete 

     'write the save as path to a string to add to the 
     'message check from html and use html tags in link 
     If objMsg.BodyFormat <> olFormatHTML Then 
      strDeletedFile = strDeletedFiles & vbCrLf & "<file://" & strFile & ">" 
     Else 
      strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _ 
      strFile & "'>" & strFile & "</a>" 
     End If 

     'use the MsgBox command to troubleshoot. Remove it from the final code. 
     'MsgBox strDeletedFiles 

    Next i 

    'Adds the filename string to the message body and save it 
    'Checks for HTML body 
    If objMsg.BodyFormat <> olFormatHTML Then 
     objMsg.Body = vbCrLf & "The File(s) were saved to " & strDeletedFiles & vbCrLf & objMsg.Body 
    Else 
     objMsg.HTMLBody = "<p>" & "The file(s) were saved to " & strDeletedFiles & "</p>" & objMsg.HTMLBody 
    End If 
    objMsg.Save 
End If 
Next 

Exit Sub: 

Set objAttachments = Nothing 
Set objMsg = Nothing 
Set objSelection = Nothing 
Set objOL = Nothing 
End Sub 

Answer 1

私はいくつかの変更を加え、このコードは意図した目的を果たします。

Public Sub SaveAttachments(Item As Outlook.MailItem) 
Dim objOL As Outlook.Application 
Dim objAttachments As Outlook.Attachments 
Dim i As Long 
Dim lngCount As Long 
Dim strFile As String 
Dim strFolderpath As String 
Dim strDeletedFiles As String 


'Get the path to the target folder 
strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16) 
On Error Resume Next 

'Instantiate an Outlook Application Object 
Set objOL = CreateObject("Outlook.Application") 

'Set the Attachment folder 
strFolderpath = strFolderpath & "\Attachments\" 

'Check each selected item for attachements. If attachments exist, save them 
'to the strFOlderPath folder and strip them from the item. 
For Each objAttachments In Item.Attachments 

    'This code only strips attachments from mail items. 
    'If objMsg.class=olMail Then 
    'Get the Attachments collection of the item 
    Set objAttachments = Item.Attachments 
    lngCount = objAttachments.Count 
    strDeletedFile = "" 

    If lngCount > 0 Then 

     'A count down loop needs to be used for removing items 
     'from a collection. Otherwise the loop counter gets 
     'confused and only every other item is removed 

     For i = lngCount To 1 Step -1 

      'Save attachment before deleting from item. 
      'Get the file name 
      strFile = objAttachments.Item(i).FileName 

      'Combine with the path to the Temp folder. 
      strFile = strFolderpath & strFile 

      'Save the attachment as a file 
      objAttachments.Item(i).SaveAsFile strFile 

      'Delete the attachment 
      objAttachments.Item(i).Delete 

      'write the save as path to a string to add to the 
      'message check from html and use html tags in link 
      If Item.BodyFormat <> olFormatHTML Then 
       strDeletedFile = strDeletedFiles & vbCrLf & "<file://" & strFile & ">" 
      Else 
       strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _ 
       strFile & "'>" & strFile & "</a>" 
      End If 

      'use the MsgBox command to troubleshoot. Remove it from the final code. 
      'MsgBox strDeletedFiles 

     Next i 

     'Adds the filename string to the message body and save it 
     'Checks for HTML body 
     If Item.BodyFormat <> olFormatHTML Then 
      Item.Body = vbCrLf & "The File(s) were saved to " & strDeletedFiles & vbCrLf & Item.Body 
     Else 
      Item.HTMLBody = "<p>" & "The file(s) were saved to " & strDeletedFiles & "</p>" & Item.HTMLBody 
     End If 
     Item.Save 
    End If 
Next objAttachments 

Exit Sub: 

Set objAttachments = Nothing 
Set objOL = Nothing 
End Sub 

Answer 2

スクリプトをパラメータとしてトリガするメールアイテムを渡します。

たとえば、Itemを渡してItemを処理するとします。

Sub CustomMailMessageRule(Item As MailItem) 
    MsgBox "Mail message arrived: " & Item.Subject 
End Sub