Minha macro de VBA no Outlook (salva anexos recebidos e envia por e-mail) apresenta um erro 424 acompanhando da msg "O objeto é obrigatório". Alguém, por gentileza consegue identificar onde está a incosistencia que está originando esse erro e como faço pra corrigir e fazer a macro rodar. Segue o código abaixo, com a linha onde a depuração acusa o erro em destaque.
Public Sub ProcessarAnexo(Email As MailItem)
Dim DiretorioAnexos As String
Dim Anexo As Attachment
DiretorioAnexos = "C:\Users\4004142\Desktop\Recebimento de notas\XML"
For Each Anexo In Email.Attachments
If LCase(Right(Anexo.FileName, 3)) = "xml" Then
Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName
End If
Next
End Sub
Sub ProjetoEmail()
Dim OutApp As Object
Dim OutMail As Object
Dim DiretorioAnexos As String
DiretorioAnexos1 = "C:\Users\4004142\Desktop\Recebimento de notas\PDF"
DiretorioAnexos2 = "C:\Users\4004142\Desktop\Recebimento de notas\XML"
Dim MailID As String
Dim Mail As Outlook.MailItem
MailID = Email.EntryID - Linha do Erro.
Set Mail = Application.Session.GetItemFromID(MailID)
For Each Anexo In Mail.Attachments
If Right(Anexo.FileName, 3) = "pdf" Or Right(Anexo.FileName, 3) = "PDF" Then
Anexo.SaveAsFile DiretorioAnexos1 & "\" & Anexo.FileName
ElseIf Right(Anexo.FileName, 3) = "xml" Or Right(Anexo.FileName, 3) = "XML" Then
Anexo.SaveAsFile DiretorioAnexos2 & "\" & Anexo.FileName
'inicio do envio de email
Para = "[email protected]"
File = DiretorioAnexos2 & "\" & Anexo.FileName
On Error GoTo 0
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Para
.Subject = "nfe"
.HTMLBody = ""
.Attachments.Add File
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
'fim
End If
Next
Set Mail = Nothing
End Sub
Editado pela Moderação. Motivo: Utilize o botão Código (< >) para inserir código VBA ou Fórmulas.
Postado : 22/07/2020 3:27 pm