none
Macro para salvar anexos automaticamente no outlook 2007 para uma pasta RRS feed

  • Pergunta

  • Pessoal solicito ajuda.

    Preciso configurar o Outlook para que assim que receber um email, ele verifique se este e-mail contem anexo. No caso de conter anexo ele faça uma cópia deste anexo para uma pasta no diretório c:.

    Este e-mail estará configurado em sevirdor, recebendo arquivos .XML referente a nota fiscal eletrônica.

    Sei que exite uma forma via Macro (VB), mais sinceramente não tenho conhecimento para criar uma macro da forma que desejo.

    desde já agradeço.


    Rodrigo Piedade. TI
    segunda-feira, 9 de agosto de 2010 19:52

Respostas

Todas as Respostas


  • Também tenho esta necessidade pelo mesmo motivo.

    O Fisco nos obriga a guardar o XML recebido dos fornecedores, e portanto, seria muito útil que uma ferramenta analisasse o e-mail e sendo um XML, salvasse o anexo em uma pasta determinada para isto.

     

    Evandro Milani
    TI - DN Automação

    terça-feira, 26 de outubro de 2010 15:19
  • Tambem estou precisando disso, vou aguardar..

    agradeço desde já.

    sexta-feira, 12 de novembro de 2010 11:18
  • Segue o link.

    http://www.fontstuff.com/outlook/oltut01.htm

    Possui um how to para desenvolvimento da sua macro amigo.

    []'s,

     


    " Qm tem boca vai a roma, meu fogão tem 6 e não saiu da cozinha ainda"
    domingo, 21 de novembro de 2010 16:15
  • Caros colegas esse procedimento que nos passaram  quem ja fez e deu certo
    quarta-feira, 8 de dezembro de 2010 10:27
  • Olá a todos,

          Eu fiz e deu certo, porém o script não respeitou a regra que falava pra copiar apenas um tipo de extenção, copiando assim tudo que veio anexado nos e-mails. Qualquer dúvida, se puder, ficarei feliz em ajudar.

    quinta-feira, 9 de dezembro de 2010 04:19
  • Este script esta pronto para XML, se quiser outra extensão basta mudar no código.

    Public Sub ProcessarAnexo(Email As MailItem)
        Dim DiretorioAnexos As String
        DiretorioAnexos = "colocar aqui a pasta destino. pode ser local em rede também"

        Dim MailID As String
        Dim Mail As Outlook.MailItem
       
        MailID = Email.EntryID
        Set Mail = Application.Session.GetItemFromID(MailID)
           
        For Each Anexo In Mail.Attachments
            If Right(Anexo.FileName, 3) = "xml" Then
                MsgBox (Anexo.FileName)
                Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName
            End If
        Next
       
        Set Mail = Nothing
    End Sub

    • Sugerido como Resposta Benilton Barbosa terça-feira, 6 de setembro de 2011 02:05
    • Não Sugerido como Resposta Benilton Barbosa terça-feira, 6 de setembro de 2011 02:05
    • Sugerido como Resposta Benilton Barbosa terça-feira, 6 de setembro de 2011 02:05
    segunda-feira, 1 de agosto de 2011 20:20
  • Pessoal depois de uma procura de 8 dias rrsrrsrs...

    Encontrei um tutorial bem simples e facil (Em português), eu testei e funcionou perfeitamente...
    Basta alterar o formato do arquivo e depois adequar a cada necessidade.

    http://www.ambienteoffice.com.br/outlook/executar_macro_ao_receber_e-mail/
    http://www.ambienteoffice.com.br/outlook/salvar_anexos_de_novas_mensagens_numa_pasta/

    Abraços.


    Edson Matias Fagundes Junior (Nioks)
    terça-feira, 9 de agosto de 2011 00:56
  • Mas como fazer esses macros para salvar pelo nome do arquivo e em várias pastas diferentes?

    Ainda não entendi como fazer...

     

    Obrigada


    segunda-feira, 31 de outubro de 2011 13:37
  • Pessoal, quando vou na caisa para selecionar o script, nas regras do outlook nao aparece nenhum para mim selecionar.

    Alguem ja teve este problema?

     

    Abraços

     

    quinta-feira, 3 de novembro de 2011 17:24
  • Boa Noite , Deis de Ja agradeço o Tech_Tom por ter nos deixado este script

    Franscisco para que apareça o script é preciso cria lo, para criar ele basta no seu outlook apertar Alt + F11

    Aparecera uma tela nesta tela você ira Clicar em cima da palavra Projeto1 Com botao direito do Mouse

    Aperte Inserir Modulo

    Ira aparecer uma tela em branco!

    cole isto la

    Public Sub ProcessarAnexo(Email As MailItem)
        Dim DiretorioAnexos As String
        DiretorioAnexos = "colocar aqui a pasta destino. pode ser local em rede também EXEMPLO C:\NOVAPASTA"
    
        Dim MailID As String
        Dim Mail As Outlook.MailItem
        
        MailID = Email.EntryID
        Set Mail = Application.Session.GetItemFromID(MailID)
            
        For Each Anexo In Mail.Attachments
            If Right(Anexo.FileName, 3) = "xml" Then
                MsgBox (Anexo.FileName)
                Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName
            End If
        Next
        
        Set Mail = Nothing
    End Sub


    Após isto Feche e crie uma regra e selecione script , clique em cima do script e selecione módulo1 e pronto, termine a regra e execute a.


    • Editado Fábio JrModerator quinta-feira, 30 de agosto de 2012 12:26 Formatação do Código
    quarta-feira, 29 de agosto de 2012 21:22
  • Bom dia,

    Foi muito util o codigo fornecido pelo Tech_Tom, porem identifiquei um probleminha e segue o corrigido:

    Public Sub ProcessarAnexo(Email As MailItem)
        Dim DiretorioAnexos As String
        
        DiretorioAnexos = "C:\NFE"
        
        Dim MailID As String
        Dim Mail As Outlook.MailItem
        
        MailID = Email.EntryID
        Set Mail = Application.Session.GetItemFromID(MailID)
            
        For Each Anexo In Mail.Attachments
            If Right(Anexo.FileName, 3) = "xml" Then
                MsgBox (Anexo.FileName)
                Anexo.SaveAsFile DiretorioAnexos & "\" & Anexo.FileName
                
            End If
        Next
        
        Set Mail = Nothing
    End Sub

    No caminho do arquivo, se colocarmos o c:\nfe\ ele da erro e nao aceita gravar.

    portanto deve-se colocar c:\nfe e o \ eu coloquei ao salvar o arquivo, nesse linha:

    Anexo.SaveAsFile DiretorioAnexos & "\" & Anexo.FileName

    Mesmo assim, obrigado pelo codigo foi de muita ajuda aqui na empresa onde trabalho.


    Marcos Aurelio Analista de Suporte

    • Sugerido como Resposta Marcos Aurélio quinta-feira, 8 de novembro de 2012 11:01
    quinta-feira, 8 de novembro de 2012 11:01
  • Bom dia,

    Foi muito util o codigo fornecido pelo Tech_Tom, porem identifiquei um probleminha e segue o corrigido:

    Public Sub ProcessarAnexo(Email As MailItem)
        Dim DiretorioAnexos As String
        
        DiretorioAnexos = "C:\NFE"
        
        Dim MailID As String
        Dim Mail As Outlook.MailItem
        
        MailID = Email.EntryID
        Set Mail = Application.Session.GetItemFromID(MailID)
            
        For Each Anexo In Mail.Attachments
            If Right(Anexo.FileName, 3) = "xml" Then
                MsgBox (Anexo.FileName)
                Anexo.SaveAsFile DiretorioAnexos & "\" & Anexo.FileName
                
            End If
        Next
        
        Set Mail = Nothing
    End Sub

    No caminho do arquivo, se colocarmos o c:\nfe\ ele da erro e nao aceita gravar.

    portanto deve-se colocar c:\nfe e o \ eu coloquei ao salvar o arquivo, nesse linha:

    Anexo.SaveAsFile DiretorioAnexos & "\" & Anexo.FileName

    Mesmo assim, obrigado pelo codigo foi de muita ajuda aqui na empresa onde trabalho.


    Marcos Aurelio Analista de Suporte

    Boa tarde,

    Pessoal rodo tudo certinho aqui na versão 2007, porem ele pede uma confirmação para salvar o arquivo é possível tirar isso?

    quarta-feira, 21 de novembro de 2012 19:25
  • Ola pessoal

    ja usei esse script no outlook 2007 e funcionou perfeitamente, porem hoje preciso usar esse script no outlook 2010

    eu tentei mas nao deu certo nao salva o anexo

    e para testes dei um msgbox e mesmo assim nao apareceu nenhuma mensagem

    testei a regra e criei para mover a mensagem de pastas e funcionou, pelo que percebi só nao esta funcionando a parte do script

    alguem sabe se no 2010 muda alguma coisa?

    Grato

    segunda-feira, 3 de dezembro de 2012 17:10
  • Fabyo,

    Sugiro que procure ajuda no fórum do Outlook, o problema parece ser configuração do outlook, deve haver algum lugar que libere execução de scripts.


    Fábio de Paula Junior

    • Sugerido como Resposta Fabyo Guimaraes terça-feira, 4 de dezembro de 2012 09:43
    segunda-feira, 3 de dezembro de 2012 22:29
    Moderador
  • Obrigado Fabio

    era isso mesmo fui la em opções e liberei a execução de macros

    valeu

    terça-feira, 4 de dezembro de 2012 09:43
  • Pessoal,

    Bom dia!

    O script está funcionando 100%, porém ele só salva o arquivo quando clicamos em OK na janela que aparece!

    Tem como colocar no código alguma opção para que ele já salve automaticamente? Sem precisar de clicar em nada?

    Desde já obrigado.

    Gedaías Brandão

    sexta-feira, 4 de janeiro de 2013 11:48
  • Ola apenas exclua a linha MsgBox(Anexo.FileName)  testado com sucesso este comando que envia mensagem ao receber arquivo automatico

    Public Sub ProcessarAnexo(Email As MailItem)
         Dim DiretorioAnexos As String
         
         DiretorioAnexos = "C:\NFE"
         
         Dim MailID As String
         Dim Mail As Outlook.MailItem
         
         MailID = Email.EntryID
         Set Mail = Application.Session.GetItemFromID(MailID)
             
         For Each Anexo In Mail.Attachments
             If Right(Anexo.FileName, 3) = "xml" Then
                 Anexo.SaveAsFile DiretorioAnexos & "\" & Anexo.FileName
                 
             End If
         Next
         
         Set Mail = Nothing
     End Sub

    quarta-feira, 23 de janeiro de 2013 22:48
  • Muito obrigado Aqmeira...

    Agora o script funciona sem precisar clicar no OK para ele salvar o arquivo.

    Abraço!

    quinta-feira, 21 de fevereiro de 2013 13:07
  • O script funciona perfeitamente!

    Por gentileza preciso de uma ourra ajuda, pois tenho dois emails configurados na mesma caixa de correio, como faço para criar um outro projetos no vba, para a segunda conta no outlook?

    Desde já agrdeço.

    quarta-feira, 20 de março de 2013 11:49
  • Fernando,

    Aqui vc consegue ajuda sobre codificação, seria melhor (e mais rápido) vc postar sua dúvida no fórum de VBA ou de Office.

    http://social.msdn.microsoft.com/Forums/pt-br/vbapt/threads


    Fábio de Paula Junior

    quinta-feira, 21 de março de 2013 00:21
    Moderador
  • bom dia,

    Eu recebo muito e-mail com anexo XML e não consigo salva-lo para enviar ao setor contábil.

    Tentei seguir esse passo a passo acima, mas não deu certo, o que eu percebi é que os anexo vem todos com mesmo nome e isso não esta permitindo salvar como novos arquivos.

    Se algum poder me ajudar agradeço imensamente.

    Att,

    Palmira Ap.

    quarta-feira, 24 de julho de 2013 12:42
  • Pessoal,

    Deixo meus agradecimentos, isso vai facilitar e muito o meu trabalho!

    Fiz passo a passo, só não dava certo por causa liberação da Macro, depois que liberei deu certinho.

    Obrigada mesmo.

    Att.

    Helena

    segunda-feira, 16 de setembro de 2013 20:45
  • Oi, Bom dia!

    Onde libero a execução de macros no Outlook 2007?

    Obrigado!!!!

    quarta-feira, 25 de junho de 2014 13:08
  • Boa noite!

    Gostaria de saber se conseguiu resolver o problemas do Scritp no Outlook 2010? tmb estou com o mesmo problemas e não consegui resolver.

    Abços

    sábado, 1 de agosto de 2015 22:17
  • desse script abaixo algo necessita ser alterado para rodar no OUTLOOK 2016 - pois estava funcionando do 2013 e parou de rodar.

    Public Sub ProcessarAnexo(Email As MailItem)
         Dim DiretorioAnexos As String
         
         DiretorioAnexos = "C:\NFE"
         
         Dim MailID As String
         Dim Mail As Outlook.MailItem
         
         MailID = Email.EntryID
         Set Mail = Application.Session.GetItemFromID(MailID)
             
         For Each Anexo In Mail.Attachments
             If Right(Anexo.FileName, 3) = "xml" Then
                 Anexo.SaveAsFile DiretorioAnexos & "\" & Anexo.FileName
                 
             End If
         Next
         
         Set Mail = Nothing
     End Sub

    Preciso de uma ajuda para Outlook 2016 estava funcionando e parou? 
    quarta-feira, 9 de setembro de 2015 23:23
  • Olá bom dia, esse post já tem tanto tempo e ainda é muito útil :). Segui os passos acima para criação da Macro, mas não consegui criar uma regra e selecionar script.

    Como faço para criar uma regra e selecionar o script que foi feito.

    Desde já gradeço.

    Abçs

    Ronaldo Miguel

    quinta-feira, 8 de outubro de 2015 11:22
  • Pessoal já encontrei, muito obrigado.

    quinta-feira, 8 de outubro de 2015 12:00
  • ja coloquei a regra para funcionar, mas preciso realmente separar o que for anexo do conteudo de imagens que vai na assinatura, quando eu recebo um e-mail

    alguma dica?

    quinta-feira, 15 de outubro de 2015 03:30
  • Pessoal,

    eu peguei neste fórum o script para salvar anexo do outlook em xml em uma determinada pasta. Depois que instalei o script e fiz as configurações de regras e alertas ele funcionou perfeitamente. No entanto, depois de algumas horas ele para de executar script, e nem se eu realizar a execução de regras e alertas manualmente ele salva o xml na pasta.

    Fiz este procedimento no outlook 2007 e também no outlook 2013 e todos apresentaram o mesmo problema.

    Alguém sabe como resolvo este problema?

    Public Sub ProcessarAnexo(Email As MailItem)
        Dim DiretorioAnexos As String
        
        DiretorioAnexos = "C:\Documents and Settings\Vinicius\Meus documentos\TESTE NFE"
        
        Dim MailID As String
        Dim Mail As Outlook.MailItem
        
        MailID = Email.EntryID
        Set Mail = Application.Session.GetItemFromID(MailID)
            
        For Each Anexo In Mail.Attachments
            If Right(Anexo.FileName, 3) = "xml" Then
                MsgBox (Anexo.FileName)
                Anexo.SaveAsFile DiretorioAnexos & "\" & Anexo.FileName
                
            End If
        Next
        
        Set Mail = Nothing
    End Sub

    terça-feira, 24 de novembro de 2015 17:09
  • https://social.technet.microsoft.com/Forums/pt-BR/6be15867-7e28-4655-8d70-427348aafa90/macro-para-o-outlook-2010?forum=scriptadminpt

    Alguem poderia me ajudar no tópico acima?

    segunda-feira, 11 de janeiro de 2016 15:34
  • Bom dia pessoal,

    O script funcionou perfeitamente, mas gostaria de saber se tem como eu salvar o arquivo em anexo com o nome do assunto do e-mail.

    quinta-feira, 11 de agosto de 2016 09:59
  • Olá, boa tarde! Você já conseguiu fazer funcionar? Estou com o mesmo problema no office 2016.

    Muito obrigado.

    Jaison Benvenutti


    terça-feira, 25 de outubro de 2016 17:16
  • Boa tarde.

    Tentei executar esse script, porem ele sai do For, como se meu e-mail não tivesse nenhum anexo dentro. Mas estou com dois arquivos .xml dentro. Poderia me ajudar?

    Meu outlook é o 2010.

    sexta-feira, 26 de maio de 2017 18:53
  • Olá.

    Este código que aperfeiçoei com base em vários modelos que encontrei na internet. Ele renomeia e salva os XML das notas em três pastas uma para as CTe, uma para as NFe e uma para as NFCe.

    Espero que seja útil para mais alguém.

    Public Sub ProcessarAnexo(Email As Outlook.MailItem)
         Dim DiretorioAnexos As String
         DiretorioAnexos = "X:\NOTAS\"
         Dim MailID As String
         Dim Mail As Outlook.MailItem
         Dim Anexo As Outlook.Attachment
         Dim FSO As Object
         MailID = Email.EntryID
         Set Mail = Application.Session.GetItemFromID(MailID)
         For Each Anexo In Mail.Attachments
             If Right(Anexo.FileName, 4) = ".xml" Or Right(Anexo.FileName, 4) = ".XML" Then
                Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName
                Set objParser = CreateObject("Microsoft.XMLDOM")
                 objParser.Load (DiretorioAnexos + Anexo.FileName)
                 oldFileName = DiretorioAnexos + Anexo.FileName
                 
                 If (objParser.getElementsByTagName("mod").Length = 1) Then
                 
                 Set ElemList = objParser.getElementsByTagName("mod")
                 ver = ElemList.Item(0).text
                 
                 ElseIf (objParser.getElementsByTagName("procEventoNFe").Length = 1) Then
                 newFileName = DiretorioAnexos & "NFe\" & Anexo.FileName
                 
                 ElseIf (objParser.getElementsByTagName("procEventoCTe").Length = 1) Then
                 newFileName = DiretorioAnexos & "CTe\" & Anexo.FileName
                 
                 Else
                 newFileName = DiretorioAnexos & Anexo.FileName
                 
                 GoTo Fim
                 
                 End If
                 
                 If ver = "55" Then
                 Set ElemList = objParser.getElementsByTagName("nNF")
                 nNF = Format(ElemList.Item(0).text, "000000")
    
                 Set ElemList = objParser.getElementsByTagName("chNFe")
                 chNFe = ElemList.Item(0).text
                 
                 
                 Set ElemList = objParser.getElementsByTagName("dhEmi")
                 dhEmi = ElemList.Item(0).text
                 dhEmi = Replace(dhEmi, ":", "-")
                 dhEmi = Left(dhEmi, 19)
                 
                 
                 Set ElemList = objParser.getElementsByTagName("xNome")
                 xNome = ElemList.Item(0).text
                 xNome = Special_Characters((xNome))
                 xNome = Left(xNome, 20)
                 newFileName = DiretorioAnexos & "NFe\" & dhEmi + "_" + nNF + "_" + xNome + "_" + chNFe + ".xml"
                 
                 ElseIf ver = "65" Then
                 Set ElemList = objParser.getElementsByTagName("nNF")
                 nNF = Format(ElemList.Item(0).text, "000000")
    
                 Set ElemList = objParser.getElementsByTagName("chNFe")
                 chNFe = ElemList.Item(0).text
                 
                 
                 Set ElemList = objParser.getElementsByTagName("dhEmi")
                 dhEmi = ElemList.Item(0).text
                 dhEmi = Replace(dhEmi, ":", "-")
                 dhEmi = Left(dhEmi, 19)
                 
                 
                 Set ElemList = objParser.getElementsByTagName("xNome")
                 xNome = ElemList.Item(0).text
                 xNome = Special_Characters((xNome))
                 xNome = Left(xNome, 20)
                 newFileName = DiretorioAnexos & "NFCe\" & dhEmi + "_" + nNF + "_" + xNome + "_" + chNFe + ".xml"
                 
                 ElseIf ver = "57" Then
                 Set ElemList = objParser.getElementsByTagName("nCT")
                 nCT = Format(ElemList.Item(0).text, "000000")
                 
                    If (objParser.getElementsByTagName("chCT").Length = 1) Then
                 
                        Set ElemList = objParser.getElementsByTagName("chCT")
                        chCT = ElemList.Item(0).text
                 
                    Else
                 
                        Set ElemList = objParser.getElementsByTagName("chCTe")
                        chCT = ElemList.Item(0).text
                 
                    End If
                             
    
                 Set ElemList = objParser.getElementsByTagName("dhEmi")
                 dhEmi = ElemList.Item(0).text
                 dhEmi = Replace(dhEmi, ":", "-")
                 dhEmi = Left(dhEmi, 19)
                 
                 
                 Set ElemList = objParser.getElementsByTagName("xNome")
                 xNome = ElemList.Item(0).text
                 xNome = Special_Characters((xNome))
                 xNome = Left(xNome, 20)
                 newFileName = DiretorioAnexos & "CTe\" & dhEmi + "_" + nCT + "_" + xNome + "_" + chCT + ".xml"
                 
                 Else
                 newFileName = DiretorioAnexos & Anexo.FileName
                 
                 End If
    Fim:
                 Set FSO = CreateObject("Scripting.FileSystemObject")
                 
                 If FSO.FileExists(newFileName) = False Then
                 
                    FSO.MoveFile oldFileName, newFileName
                 
                 Else
                 
                    FSO.DeleteFile oldFileName, True
                 
                 End If
             End If
        Next
         Set Mail = Nothing
     End Sub
     
     Function Special_Characters(TESTVALUE As String)
        Dim changename As String
        Dim SP As String
        Dim SP_C() As String
        
        changename = TESTVALUE
        
        SP = "! @ # $ % ^ & * * ( ) _ + = - \ | ] } [ { ' : / ? > . < , ; "
        SP_C = Split(SP, " ")
       
        For I = o To UBound(SP_C)
       
            CHAR = SP_C(I)
            changename = Replace(changename, CHAR, "")
       
        Next
       
        Special_Characters = changename
     
     End Function


    • Sugerido como Resposta SantosRenanR sexta-feira, 2 de junho de 2017 23:06
    • Editado SantosRenanR sexta-feira, 16 de fevereiro de 2018 01:53 Verção 2.0 do codigo
    sexta-feira, 2 de junho de 2017 23:05
  • Olá.

    Este código que aperfeiçoei com base em vários modelos que encontrei na internet. Ele renomeia e salva os XML das notas duas pastas uma para as CTe e uma para as NFe.

    Espero que seja útil para mais alguém.

    Public Sub ProcessarAnexo(Email As MailItem)
         Dim DiretorioAnexos As String
         DiretorioAnexos = "X:\NOTAS\"
         Dim MailID As String
         Dim Mail As Outlook.MailItem
         Dim fso
    
         MailID = Email.EntryID
         Set Mail = Application.Session.GetItemFromID(MailID)
    
         For Each Anexo In Mail.Attachments
             If Right(Anexo.FileName, 4) = ".xml" Or Right(Anexo.FileName, 4) = ".XML" Then
                Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName
                Set objParser = CreateObject("Microsoft.XMLDOM")
                 objParser.Load (DiretorioAnexos + Anexo.FileName)
    
                 oldFileName = DiretorioAnexos + Anexo.FileName
                 
                 If (objParser.getElementsByTagName("NFe").Length = 1) Then
    
                 Set ElemList = objParser.getElementsByTagName("nNF")
                 nNF = Format(ElemList.Item(0).Text, "000000")
    
    
                 Set ElemList = objParser.getElementsByTagName("chNFe")
                 chNFe = ElemList.Item(0).Text
                 
                 
                 Set ElemList = objParser.getElementsByTagName("dhEmi")
                 dhEmi = ElemList.Item(0).Text
                 dhEmi = Replace(dhEmi, ":", "-")
                 dhEmi = Left(dhEmi, 19)
                 
                 
                 Set ElemList = objParser.getElementsByTagName("xNome")
                 xNome = ElemList.Item(0).Text
                 xNome = Replace(xNome, " ", "_")
                 xNome = Left(xNome, 20)
    
                 newFileName = DiretorioAnexos & "NFe\" & dhEmi + "_" + nNF + "_" + xNome + "_" + chNFe + ".xml"
                 
                 End If
                 
                 If (objParser.getElementsByTagName("procEventoNFe").Length = 1) Then
    
                 newFileName = DiretorioAnexos & "NFe\" & Anexo.FileName
                 
                 End If
                 
                 If (objParser.getElementsByTagName("NFe").Length = 1) Then
    
                 newFileName = DiretorioAnexos & "NFe\" & Anexo.FileName
                 
                 End If
                 
                 If (objParser.getElementsByTagName("CTe").Length = 1) Then
    
                 Set ElemList = objParser.getElementsByTagName("nCT")
                 nCT = Format(ElemList.Item(0).Text, "000000")
                 
                 If (objParser.getElementsByTagName("chCT").Length = 1) Then
                 
                    Set ElemList = objParser.getElementsByTagName("chCT")
                    chCT = ElemList.Item(0).Text
                 
                 Else
                 
                    Set ElemList = objParser.getElementsByTagName("chCTe")
                    chCT = ElemList.Item(0).Text
                 
                 End If
                              
                 Set ElemList = objParser.getElementsByTagName("dhEmi")
                 dhEmi = ElemList.Item(0).Text
                 dhEmi = Replace(dhEmi, ":", "-")
                 dhEmi = Left(dhEmi, 19)
                 
                 
                 Set ElemList = objParser.getElementsByTagName("xNome")
                 xNome = ElemList.Item(0).Text
                 xNome = Replace(xNome, " ", "_")
                 xNome = Left(xNome, 20)
    
                 newFileName = DiretorioAnexos & "CTe\" & dhEmi + "_" + nCT + "_" + xNome + "_" + chCT + ".xml"
                 
                 End If
                 
                 If (objParser.getElementsByTagName("procEventoCTe").Length = 1) Then
    
                 newFileName = DiretorioAnexos & "CTe\" & Anexo.FileName
                 
                 End If
                 
                 If (objParser.getElementsByTagName("CTe").Length = 1) Then
    
                 newFileName = DiretorioAnexos & "CTe\" & Anexo.FileName
                 
                 End If
    
                 Set fso = CreateObject("Scripting.FileSystemObject")
                 fso.MoveFile oldFileName, newFileName
             End If
         Next
    
         Set Mail = Nothing
     End Sub


    Boa tarde,

    Uso o outlook 2010 e não consigo criar essa macro, alguem poderia me ensinar o passo a passo? eu tenho uma base no excel somente


    quinta-feira, 17 de agosto de 2017 18:22
  • Os Links  estao quebrados teria os novos?
    quinta-feira, 24 de agosto de 2017 00:43
  • me envia o cod ?

    Vitor.hugo_santos@hotmail.com

    att

    quinta-feira, 24 de agosto de 2017 00:45
  • poderia me da um help nesse cod? @Roliveira_Batista

    coloco ele dentro de um modulo? 

    Whats 61 9-93535904

    Att

    quinta-feira, 24 de agosto de 2017 16:10
  • poderia me da um help nesse cod? @Roliveira_Batista

    coloco ele dentro de um modulo? 

    Whats 61 9-93535904

    Att

    Então amigo eu também estou com dificuldade nesses códigos, la no meu comemtarios  também estou pedindo ajuda.
    terça-feira, 29 de agosto de 2017 15:55
  • Com relação a criação de macros, poderiam me ajudar com as seguintes dúvidas:

    1. Gostaria de um script para encaminhar todos os e-mails recebidos pelo outlook para uma pasta específica.

    2. Distribuir esses e-mail salvos em uma pasta em diversas outras pastas, determinado pelo assunto do e-mail ou pelo conteúdo (um número de série por exemplo).

    Alguma dica?


    quarta-feira, 13 de dezembro de 2017 11:58