none
Macro para receber automaticamente arquivos dos anexos em eml no outlook RRS feed

  • Pergunta

  • Tenho um scritp conforme abaixo para baixar arquivos xml e pdf recebidos no meu outlook, ele funciona perfeitamente no outlook 2010, porem no 2013 não está funcionando, será que alguém pode me ajudar?


    Public Sub ProcessarAnexo(Email As MailItem)

     Dim DiretorioAnexos As String

     Dim strDATAHORA As String

     Dim NomeArquivo As String



     DiretorioAnexos = "C:\fabio"



     strDATAHORA = Right("0" & Day(Now), 2) & Right("0" & Month(Now), 2) & 

    Year(Now) & _

     " " & Right("0" & Hour(Now), 2) & Right("0" & Minute(Now), 2) & Right("0" & 

    Second(Now), 2)

     Dim MailID As String

     Dim Mail As Outlook.MailItem

     MailID = Email.EntryID

     Set Mail = Application.Session.GetItemFromID(MailID)

     i = 1

     For Each Anexo In Mail.Attachments

     If Right(Anexo.FileName, 3) = "xml" Then

     NomeArquivo = Left(Anexo.FileName, Len(Anexo.FileName) - 4) & _

     "_" & strDATAHORA & _

     i & _

     Right(Anexo.FileName, 4)



     Anexo.SaveAsFile DiretorioAnexos & "\" & NomeArquivo

     i = i + 1

     End If

     Next

     Set Mail = Application.Session.GetItemFromID(MailID)

     i = 1

     For Each Anexo In Mail.Attachments

     If Right(Anexo.FileName, 3) = "pdf" Then

     NomeArquivo = Left(Anexo.FileName, Len(Anexo.FileName) - 4) & _

     "_" & strDATAHORA & _

     i & _

     Right(Anexo.FileName, 4)



     Anexo.SaveAsFile DiretorioAnexos & "\" & NomeArquivo

     i = i + 1

     End If

     Next

     Set Mail = Nothing

    End Sub

        
    • Movido Fábio Jr quarta-feira, 2 de abril de 2014 13:40 Mais adequado VBA
    terça-feira, 1 de abril de 2014 15:57

Todas as Respostas