VBA 选择触发脚本的电子邮件 [英] VBA Select email that triggers script

问题描述

我正在开发一个 Outlook 脚本，该脚本将自动选择和下载来自特定发件人的附件.目前报告是在数据库上生成并通过电子邮件发送到指定地址 - 下一步是将这些报告自动下载到指定文件夹.目前，如果电子邮件来自指定的发件人，脚本会从当前选择的电子邮件下载电子邮件，我需要编写脚本以从触发脚本的发件人处选择电子邮件.

I am working on a Outlook script that will automatically select and download the attachments from a specific sender. Currently reports are generated on a database and emailed to a specified address - the next step is to automatically download those reports to a specified folder. Currently if an email comes in from the specified sender the script downloads the email from the currently selected email, I need to script to select the email from the sender that triggers the script.

我对 VBA 非常陌生，任何帮助将不胜感激.

I'm extremely new to VBA, any help would be greatly appreciated.

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

推荐答案

我做了一些改动，这段代码达到了预期的目的.

I made some changes and this code does the intended purpose.

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

这篇关于VBA 选择触发脚本的电子邮件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！