创建带有电子邮件主题名称的文件夹,用于辅助交换帐户中的传入电子邮件

时间:2019-02-20 16:04:58

标签: vba outlook outlook-vba

我需要创建一个宏来读取传入的电子邮件,如果它们来自某个域,请创建一个带有主题名称的文件夹并将其存储在该文件夹中。但是,我需要使用它来在公司邮件下配置的辅助交换帐户中工作。我不知道如何指向宏以在其中收听和操作。

现在我有了它,它可以成功侦听传入的邮件并识别从我感兴趣的域中收到的邮件,并抛出调试标志,但仅针对我的主帐户的收件箱:

Function getSmtpMailAddress(oMail) As String
    Dim outlookApp As Outlook.Application, oOutlook As Object
    Dim strAddress As String, strEntryId As String
    Dim objAddressentry As Outlook.AddressEntry, objExchangeUser As Outlook.ExchangeUser
    Dim objReply As Outlook.MailItem, objRecipient As Outlook.Recipient

    Set outlookApp = New Outlook.Application
    Set oOutlook = outlookApp.GetNamespace("MAPI")
    Set oInbox = oOutlook.GetDefaultFolder(olFolderInbox)

    If oMail.SenderEmailType = "SMTP" Then
        strAddress = oMail.SenderEmailAddress
    Else
        Set objReply = oMail.Reply()
        On Error Resume Next
        Set objRecipient = objReply.Recipients.item(1)
        strEntryId = objRecipient.EntryID
        objReply.Close OlInspectorClose.olDiscard
        strEntryId = objRecipient.EntryID
        'On Error GoTo ErrorServerUnavailable
        Set objAddressentry = oOutlook.GetAddressEntryFromID(strEntryId)
        'On Error GoTo 0
        Set objExchangeUser = objAddressentry.GetExchangeUser()
        strAddress = objExchangeUser.PrimarySmtpAddress()
        On Error GoTo 0
    End If
    getSmtpMailAddress = strAddress
Exit Function

ErrorServerUnavailable:
    'MsgBox "Servidor de correos no puede ser contactado", vbInformation, "Error: Servidor de correos"
    'End
End Function

哪些设置:

Sub RevisarCorreo(oMail As MailItem)
    '-------------------------------
    'reads data from incoming mail'
    eFrom = getSmtpMailAddress(oMail) 'oMail.SenderEmailAddress
    eTo = oMail.To
    eSubject = oMail.Subject
    eBody = oMail.Body
    '-------------------------------
    'Evaluations'
    EsdeTecnicas = Contiene(eFrom, "corporate.mail@example.com", DisableCaseSensitive)

    '-------------------------------
    'actions'
    '-------------------------------
    'if the mail is from what I'm interested'
    If EsdeTecnicas Then

        'Debug flag'
        DesplegarAlerta "Aviso importante: " & eSubject, "Aviso importante", oMail

    'here comes function to create folder with subject name'
        'but i dont know how to point the whole thing to "listen the other exchange account, and create the folder there, not in the main acc'

    End If

End Sub

我研究了官方文档,但找不到解决方法。我是vba的入门者(实际上这是我尝试使用Outlook的第一个宏)

0 个答案:

没有答案