Error: 438 - VB Outlook
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
Discussão (3)
Carregando comentários...