Error: 438 - VB Outlook

[João Otávio 21 0]

Boa tarde pessoal,

 

Estou programando meu Outlook para sempre que eu receber um email de uma respectiva pessoa (no caso mariana.lemos@cnh.com) e que houver anexo, o Outlook salve automaticamente o anexo em uma pasta específica do meu servidor.

 

Porém, ele esta retornando o Erro 438: "Objeto não suporta essa propriedade ou método".

 

Alguém poderia me informar o motivo deste erro ? O meu código está disponível abaixo, caso ajude.

Sub GetAttachments()
    On Error GoTo GetAttachments_err
    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim Item As Object
    Dim Atmt As Attachment
    Dim FileName As String
    Dim Arq As Integer
    Dim i As Integer
    Dim MyString As String
    Dim AcheiNoEmail As Boolean
    
    AcheiNoEmail = False
    Arq = FreeFile
    
    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    i = 0
    
    If Inbox.Items.Count = 0 Then
        MsgBox "Ñ existem msgs na Caixa de Entrada.", vbInformation, "Não Encontrado"
        Exit Sub
    End If
    
    If Dir("c:\shipmentsEmail.txt") <> "" Then
        Open "c:\shipmentsEmail.txt" For Input As #Arq
            Input #Arq, MyString
        Close #Arq
    Else
        MyString = Format(Now - 1, "YYYYMMDDHHMMSS")
    End If
    
    For Each Item In Inbox.Items
        assunto = Item.Subject
        naoLido = Item.UnRead
        Sender = Item.SenderEmailAddress
        datarecebida = Item.ReceivedTime
        
        For Each Atmt In Item.Attachments
            If Sender = "mariana.lemos@cnh.com" Then
                If Format(datarecebida, "YYYYMMDDHHMMSS") > MyString Then
                    If Right(Atmt.FileName, 3) = "zip" Then
                        If naoLido = True Then
                            If Left(assunto, 69) = "CNH America LLC Saved View IBCLAR - Belo Horizonte M. Planner USA-LAR" Then
                                FileName = "\\146.47.116.20/applic$/cebh/SQLLOAD/SHIPMENTS/" & Atmt.FileName
                                Atmt.SaveAsFile FileName
                                i = i + 1
                                AcheiNoEmail = True
                            End If
                        End If
                    End If
                End If
            End If
        Next Atmt
    Next Item
    
    If AcheiNoEmail Then
        Open "c:\shipmentsEmail.txt" For Output As #Arq
            Print #Arq, Format(Now, "YYYYMMDDHHMMSS")
        Close #Arq
    End If
    
GetAttachments_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub
    
GetAttachments_err:
    MsgBox "An unexpected error has occurred." _
    & vbCrLf & "Please note and report the following information." _
    & vbCrLf & "Macro Name: GetAttachments" _
    & vbCrLf & "Error Number: " & Err.Number _
    & vbCrLf & "Error Description: " & Err.Description _
    , vbCritical, "Error!"
    Resume GetAttachments_exit
    
    Exit Sub
End Sub

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Call GetAttachments
End Sub

Obrigado,

 

João Otávio

[KhaosDoctor 242]

Qual é a linha exata do erro?

[João Otávio 21 0]

Ele não me retorna a linha exata do erro.. Mas o erro está no meu loop.

 

Ele só retorna o alert dizendo:

"Erro em tempo de execução '438': O objeto não aceita esta propriedade ou método."

 

For Each Item In Inbox.Items
        assunto = Item.Subject
        naoLido = Item.UnRead
        Sender = Item.SenderEmailAddress
        datarecebida = Item.ReceivedTime
        
        For Each Atmt In Item.Attachments
            If Sender = "mariana.lemos@cnh.com" Then
                If Format(datarecebida, "YYYYMMDDHHMMSS") > MyString Then
                    If Right(Atmt.FileName, 3) = "zip" Then
                        If naoLido = True Then
                            If Left(assunto, 69) = "CNH America LLC Saved View IBCLAR - Belo Horizonte M. Planner USA-LAR" Then
                                FileName = "\\146.47.116.20/applic$/cebh/SQLLOAD/SHIPMENTS/" & Atmt.FileName
                                Atmt.SaveAsFile FileName
                                i = i + 1
                                AcheiNoEmail = True
                            End If
                        End If
                    End If
                End If
            End If
        Next Atmt
    Next Item

[KhaosDoctor 242]

O erro está definindo que uma das linhas ai no seu código está errada, ou seja, um método não está recebendo as propriedades corretas ou algum atributo não é válido.