Pessoal, preciso de ajuda para identificar o que preciso corrigir no meu código para que a macro possa executar. Essa macro tem a finalidade de anexar arquivos recebidos por email e, depois enviar para outros destinatários. Sempre quando tento executa-la o erro 424 aparece com a seguinte mensagem: "O objeto é obrigatório", alguém poderia me ajudar a solucionar isso? Ficaria extremamente agradecido. Segue o código abaixo (Destaquei a linha do erro) :
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 onde a depuração acusa o 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
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
Postado : 27/07/2020 8:21 pm