Erro na Macro para ...
 
Notifications
Clear all

Erro na Macro para enviar emails


pedrobga
Posts: 2
Registered
Topic starter
(@pedrobga)
New Member
Entrou: 11 meses atrás

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
            
             Para = "nfe@light.com.br"
             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
Responder
Tags do Tópico