Question

我尝试编写一些VBA以将附件文件从某些电子邮件保存到文件夹但我收到了错误

运行时错误'424'

需要对象

这是我尝试使用的代码

Sub test_extraer()
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

If (Msg.SenderName = "sender@email.com") And _
       (Msg.Subject = "subject of the email") 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

    Const attPath As String = "C:\temp\"

   Set myAttachments = item.Attachments
    Att = myAttachments.item(1).DisplayName
    myAttachments.item(1).SaveAsFile attPath & Att
End If

End Sub

如果脚本输入到

，则会触发错误

If (Msg.SenderName = "sender@email.com") And _
       (Msg.Subject = "subject of the email") And _
       (Msg.Attachments.Count >= 1) Then

任何建议

提前致谢

Answer 1

好的......从哪里开始。你肯定有一些基本的问题需要在这里解决。您有两个未声明的变量。第一个是你的头衔的原因。上下文中的msg很可能应该是Outlook.MailItem。只是声明变量不是问题的唯一来源。接下来，您有item，与上下文中的msg非常相似，应该是Outlook.MailItem。您缺少一个可以浏览收件箱中所有项目的循环。

所以，您只是想在收件箱中导航，寻找正确的特定项目？只需添加循环就会产生另一个问题。收件箱中的某些项目不是邮件项目。为了解决这个问题，我们浏览收件箱中的每个对象，并检查我们遇到的每个mailitem。如果符合发件人，主题和项目数的标准，我们会前往.SaveAsFile目的地目录。

Sub Test_ExtraER()

    Const strAttachmentPath As String = "C:\temp\"

    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim objFolder As Outlook.MAPIFolder
    Dim objItem As Object
    Dim strFileName As String

    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set objFolder = objNS.GetDefaultFolder(olFolderInbox)

    For Each objItem In objFolder.Items
        If TypeName(objItem) = "MailItem" Then
            If (objItem.Attachments.Count >= 1) And (objItem.Subject = "Some Subject") And (objItem.SenderName = "sender@email.com") Then
                With objItem.Attachments.Item(1)
                    strFileName = strAttachmentPath & .DisplayName
                    Debug.Print strFileName
                    .SaveAsFile strFileName
                End With
            End If
        End If
    Next
End Sub

这主要是偏好，但正如您所看到的，我做了一些其他的编码更改。我重命名了一些其他变量，以更加描述它的对象。同时将所有Dim和Const移到一起以提高可读性。

最后一件事。您似乎正在浏览整个收件箱，寻找一小部分邮件。您可以创建一个规则来处理这些邮件进入您的邮箱。一个例子是：Save Outlook attachment to disk

Answer 2

Sub test_extraer()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim MailItems As Outlook.MAPIFolder 'Add this one
Dim Msg As Outlook.MailItem 'Add this one
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set MailItems = objNS.GetDefaultFolder(olFolderInbox)

For Each Msg In MailItems.Items 'loop thru the inbox folder to match the exact sender name and subject
    If (Msg.SenderName = "Sender Name Here") And _
           (Msg.Subject = "Subject Here") 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

        Const attPath As String = "C:\temp\"

       Set myAttachments = Msg.Attachments
        Att = myAttachments.Item(1).DisplayName
        myAttachments.Item(1).SaveAsFile attPath & Att
    End If
Next
End Sub

尝试保存电子邮件附件时出错

2 个答案: