MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

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

    Salvar anexo no Outlook

    Compartilhe
    avatar
    Claudia_p
    Novato
    Novato

    Respeito às Regras 100%

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

    Salvar anexo no Outlook

    Mensagem  Claudia_p em Qua 27 Abr 2016, 14: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
    avatar
    Pablo Neruda
    Developer
    Developer

    Respeito às Regras 100%

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

    Re: Salvar anexo no Outlook

    Mensagem  Pablo Neruda em Qui 28 Abr 2016, 17: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..............
    avatar
    Claudia_p
    Novato
    Novato

    Respeito às Regras 100%

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

    Re: Salvar anexo no Outlook

    Mensagem  Claudia_p em Qui 28 Abr 2016, 19:59

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

      Data/hora atual: Ter 24 Out 2017, 08:42