MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Salvar anexo no Outlook

    Compartilhe

    Claudia_p
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Feminino
    Localização : Brasil
    Mensagens : 26
    Registrado : 06/12/2011

    Salvar anexo no Outlook

    Mensagem  Claudia_p em Qua 27 Abr 2016, 06:28

    Bom dia,

    Alguém saberia me apontar porque a rotina abaixo não está funcionando... O objetivo é salvar os arquivos xml recebidos em uma determinada pasta e renomeá-lo com informações do xml. Desde já agradeço!!!

    Public Sub Processar_Email(EMail As MailItem)
     
     Dim DiretorioAnexo, MailID As String
     Dim Mail As Outlook.MailItem
     Dim Anexo As Attachment
     Dim fso
     
     DiretorioAnexo = "\\Parolisrv01\sge\NFe\2016\ENTRADA\"
     
       MailID = EMail.EntryID
       Set Mail = Application.Session.GetItemFromID(MailID)

       For Each Anexo In Mail.Attachments
           On Error Resume Next
           If Right(Anexo.FileName, 3) = "xml" Then
               MsgBox ("O arquivo " & Anexo.FileName & " será salvo.")
               Anexo.SaveAsFile DiretorioAnexo & Anexo.FileName
                           
               Set objParser = CreateObject("Microsoft.XMLDOM")
               objParser.Load (DiretorioAnexo + Anexo.FileName)

               Set ElemList = objParser.getElementsByTagName("chNFe")
               FilePath = ElemList.Item(0).getAttribute("filePath")

               oldfilename = DiretorioAnexo + Anexo.FileName

               Set ElemList = objParser.getElementsByTagName("nNF")
               nNF = Format(ElemList.Item(0).Text, "000000")

               Set ElemList = objParser.getElementsByTagName("dhEmi")
               dhEmi = Left(ElemList.Item(0).Text, 10)

               Set ElemList = objParser.getElementsByTagName("xNome")
               xNome = Left(ElemList.Item(0).Text, 5)
               
               NewFileName = DiretorioAnexo + dhEmi + "_" + xNome + "_" + nNF + ".xml"
               
               Set fso = CreateObject("Scripting.FileSystemObject")
                   If (fso.FileExists(NewFileName)) Then
                   fso.DeleteFile oldfilename
                   Else
                   fso.MoveFile oldfilename, NewFileName
                   End If

                                     
           End If
       Next
               Set Mail = Nothing

    End Sub

    Pablo Neruda
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 299
    Registrado : 17/09/2010

    Re: Salvar anexo no Outlook

    Mensagem  Pablo Neruda em Qui 28 Abr 2016, 09:04

    Você gravou o código no outlook e criou uma regra para se executar o código quando da recepção do e-mail?


    .................................................................................
    [Você precisa estar registrado e conectado para ver esta imagem.] Elohim Manutenção & Sistemas
    ..............Powered by MS Access with VBA code..............
    ............http://www.elohimsistemas.com.br/...........

    Claudia_p
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Feminino
    Localização : Brasil
    Mensagens : 26
    Registrado : 06/12/2011

    Re: Salvar anexo no Outlook

    Mensagem  Claudia_p em Qui 28 Abr 2016, 11:59

    Oi Pablo, gravei sim e também vinculei a uma regra executada toda vez em que uma mensagem chegar.

      Data/hora atual: Sab 03 Dez 2016, 07:37