自动保存附件不会下载附件

时间:2018-01-22 14:03:29

标签: vba outlook-vba

有人可以告诉我这里做错了什么吗?它没有按照应有的方式接收电子邮件(即自动将附件下载到文件夹中)。没有错误消息,但根本没有动作(我去了F8,但没有发现任何违规行为)。

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)

On Error GoTo ErrorHandler

    'Only act if it's a MailItem
    Dim Msg As Outlook.MailItem
    If TypeName(item) = "MailItem" Then
        Set Msg = item

    'Change variables to match need. Comment or delete any part unnecessary.
        If (Msg.SenderName = "test123@gmail.com") And _
        (Msg.Subject = "Test123") And _
        (Msg.Attachments.Count >= 1) Then

    'Set folder to save in.
    Dim olDestFldr As Outlook.MAPIFolder
    Dim myAttachments As Outlook.Attachments
    Dim Att As String

    'location to save in.  Can be root drive or mapped network drive.
    Const attPath As String = "C:\Test\Test1\"

    ' save attachment
   Set myAttachments = item.Attachments
    Att = myAttachments.item(1).DisplayName
    myAttachments.item(1).SaveAsFile attPath & Att

   Msg.UnRead = False
End If
End If


ProgramExit:
  Exit Sub

ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description
  Resume ProgramExit
End Sub

另外,当我尝试F8的错误时,VBA只会通过代码的第一部分,即Private Sub Application_Startup(),我无法测试另一部分{Private Sub Items_ItemAdd(ByVal item As Object)}是否与VBA相同简单地拒绝一行一行(没有错误的弹出窗口或任何东西,它只是没有拿起线)

2 个答案:

答案 0 :(得分:0)

问题出在

Dim IE As Object

Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.Navigate2 "https://mis.lidl.net/MicroStrategy/servlet/mstrWeb"
IE.document.getElementbyID("mstrLargeIconViewItemName").href

你总是选择附件1,这可能是你想象的其他东西。在此周围添加myAttachments.item(1).SaveAsFile attPath & Att ,您可能会获得更好的结果。

答案 1 :(得分:0)

我的猜测是你的问题是这个条件:

If (Msg.SenderName = "test123@gmail.com")

MailItem.SenderName属性返回发件人的显示名称,可能不是实际的电子邮件地址。您应该检查MailItem.SenderEmailAddress属性。

如果您尝试匹配的电子邮件是Exchange地址(即,它来自您办公室中的某个人的Outlook帐户),则MailItem.SenderEmailAddress将返回您难以理解的字符串。 #39;我需要解析为实际的电子邮件。在这种情况下,您需要检查MailItem.Sender.GetExchangeUser()。PrimarySmtpAddress属性。

出于这个原因,我喜欢使用" emailMatches"检查两种方案的功能。然后你的情况会是这样的:

If emailMatches(Msg, "test123@company.com")

这是我使用的功能:

Function emailMatches(mItem As Object, addressToMatch As String) As Boolean

    Dim goAhead As Boolean
    goAhead = False

    If UCase(mItem.SenderEmailAddress) = UCase(addressToMatch) Then
        goAhead = True
    ElseIf Left(mItem.SenderEmailAddress, 5) = "/O=EX" Then
        If UCase(mItem.Sender.GetExchangeUser().PrimarySmtpAddress) = UCase(addressToMatch) Then
            goAhead = True
        End If
    End If

    emailMatches = goAhead

End Function