none
Colocar hora e segundos no nome do arquivo. RRS feed

  • Pergunta

  • Bom Dia!!

    Pessoal!

    Uso o script abaixo para renomear e salvar automaticamente arquivos .xml de botas fiscais que recebo, porem tenho um problema com arquivos duplicados.

    Gostaria que me ajudassem a colocar no final do arquivo a hora e segundos atuais do sistema, assim quando um arquivo tivesse duplicado, apenas salvaria mais um e nao travaria o script.

    Obrigado

    Public Sub VIAPOL(Email As MailItem)
         Dim DiretorioAnexos As String
        DiretorioAnexos = "\\10.1.1.252\sistema\Visual_rodopar\Auxiliares\XML_CLIENTES\Viapol\"
        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" Then
               Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName
               Set objParser = CreateObject("Microsoft.XMLDOM")
                objParser.Load (DiretorioAnexos + Anexo.FileName)

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

                oldFileName = DiretorioAnexos + Anexo.FileName

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


                Set ElemList = objParser.getElementsByTagName("CNPJ")
                CNPJ = ElemList.Item(0).Text

                Set ElemList = objParser.getElementsByTagName("xNome")
                xNome = ElemList.Item(0).Text
                
                Set ElemList = objParser.getElementsByTagName("placa")
                placa = ElemList.Item(0).Text
                

                newFileName = DiretorioAnexos + nNF + "_" + xNome + "_" + CNPJ + "_" + placa + ".xml"
                Set fso = CreateObject("Scripting.FileSystemObject")
                fso.MoveFile oldFileName, newFileName
            End If
        Next

        Set Mail = Nothing
    End Sub

    quarta-feira, 14 de agosto de 2013 11:09

Respostas

  • Bom dia Adrhohmann,

    Vc pode adicionar um Time no final,

    o Time retorna  a hora e segundo "09:01:23", então com Replace eu troquei o ":" por "" para alterar para  "090123".

    faça um teste

    Ficaria assim:

    Public Sub VIAPOL(Email As MailItem)
         Dim DiretorioAnexos As String
        DiretorioAnexos = "\\10.1.1.252\sistema\Visual_rodopar\Auxiliares\XML_CLIENTES\Viapol\"
        Dim MailID As String
        Dim Mail As Outlook.MailItem
        Dim fso
        
        strhora = (replace(time,":",""))
        MailID = Email.EntryID
        Set Mail = Application.Session.GetItemFromID(MailID)
       
        For Each Anexo In Mail.Attachments
            If Right(Anexo.FileName, 4) = ".xml" Then
               Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName
               Set objParser = CreateObject("Microsoft.XMLDOM")
                objParser.Load (DiretorioAnexos + Anexo.FileName)
                Set ElemList = objParser.getElementsByTagName("chNFe")
                FilePath = ElemList.Item(0).getAttribute("filePath")
                oldFileName = DiretorioAnexos + Anexo.FileName
                Set ElemList = objParser.getElementsByTagName("nNF")
                nNF = Format(ElemList.Item(0).Text, "000000")
                Set ElemList = objParser.getElementsByTagName("CNPJ")
                CNPJ = ElemList.Item(0).Text
                Set ElemList = objParser.getElementsByTagName("xNome")
                xNome = ElemList.Item(0).Text
                
                Set ElemList = objParser.getElementsByTagName("placa")
                placa = ElemList.Item(0).Text
                
                newFileName = DiretorioAnexos + nNF + "_" + xNome + "_" + CNPJ + "_" + placa + "_" + strhora + ".xml"
                Set fso = CreateObject("Scripting.FileSystemObject")
                fso.MoveFile oldFileName, newFileName
            End If
        Next
        Set Mail = Nothing
    End Sub

    Não testei..

    att, Aparecido Deveza




    • Editado Aparecido Deveza quarta-feira, 14 de agosto de 2013 12:53 link
    • Marcado como Resposta Adrhohmann quarta-feira, 14 de agosto de 2013 14:07
    quarta-feira, 14 de agosto de 2013 12:45
  • que bom que funcinou...

    então vc pode usar dois métodos...

    1 - usar o "On Error Resume Next" no inicio do Sub, isso faz com que ele continue quando há erro, indo para próxima ação...

    2 -  Seria usar um If ...

    Set ElemList = objParser.getElementsByTagName("placa")
    if placa = ElemList.Item(0).Text  = "" then
    	ElemList.Item(0).Text = "Sem Tag"
    end IF
             
    essa é a ideia, mas como não testei não sei se funciona... a ideia do IF é fazer que quando o valor não existir ele coloque um predefinido por você...

    att, Aparecido Deveza



    • Editado Aparecido Deveza quarta-feira, 14 de agosto de 2013 15:10 link
    • Marcado como Resposta Adrhohmann quarta-feira, 14 de agosto de 2013 16:48
    quarta-feira, 14 de agosto de 2013 15:09

Todas as Respostas

  • Bom dia Adrhohmann,

    Vc pode adicionar um Time no final,

    o Time retorna  a hora e segundo "09:01:23", então com Replace eu troquei o ":" por "" para alterar para  "090123".

    faça um teste

    Ficaria assim:

    Public Sub VIAPOL(Email As MailItem)
         Dim DiretorioAnexos As String
        DiretorioAnexos = "\\10.1.1.252\sistema\Visual_rodopar\Auxiliares\XML_CLIENTES\Viapol\"
        Dim MailID As String
        Dim Mail As Outlook.MailItem
        Dim fso
        
        strhora = (replace(time,":",""))
        MailID = Email.EntryID
        Set Mail = Application.Session.GetItemFromID(MailID)
       
        For Each Anexo In Mail.Attachments
            If Right(Anexo.FileName, 4) = ".xml" Then
               Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName
               Set objParser = CreateObject("Microsoft.XMLDOM")
                objParser.Load (DiretorioAnexos + Anexo.FileName)
                Set ElemList = objParser.getElementsByTagName("chNFe")
                FilePath = ElemList.Item(0).getAttribute("filePath")
                oldFileName = DiretorioAnexos + Anexo.FileName
                Set ElemList = objParser.getElementsByTagName("nNF")
                nNF = Format(ElemList.Item(0).Text, "000000")
                Set ElemList = objParser.getElementsByTagName("CNPJ")
                CNPJ = ElemList.Item(0).Text
                Set ElemList = objParser.getElementsByTagName("xNome")
                xNome = ElemList.Item(0).Text
                
                Set ElemList = objParser.getElementsByTagName("placa")
                placa = ElemList.Item(0).Text
                
                newFileName = DiretorioAnexos + nNF + "_" + xNome + "_" + CNPJ + "_" + placa + "_" + strhora + ".xml"
                Set fso = CreateObject("Scripting.FileSystemObject")
                fso.MoveFile oldFileName, newFileName
            End If
        Next
        Set Mail = Nothing
    End Sub

    Não testei..

    att, Aparecido Deveza




    • Editado Aparecido Deveza quarta-feira, 14 de agosto de 2013 12:53 link
    • Marcado como Resposta Adrhohmann quarta-feira, 14 de agosto de 2013 14:07
    quarta-feira, 14 de agosto de 2013 12:45
  • Obrigado!!

    Funcionou perfeitamente, porem cai em outro problema....

    em alguns arquivos nao contem a TAG referente ao trecho abaixo, e trava o script:

      Set ElemList = objParser.getElementsByTagName("placa")
                placa = ElemList.Item(0).Text

    Como eu faço uma condição pra verificar se a TAG em questão existe ou nao???

    Abraço e fique com DEUS

    quarta-feira, 14 de agosto de 2013 14:09
  • que bom que funcinou...

    então vc pode usar dois métodos...

    1 - usar o "On Error Resume Next" no inicio do Sub, isso faz com que ele continue quando há erro, indo para próxima ação...

    2 -  Seria usar um If ...

    Set ElemList = objParser.getElementsByTagName("placa")
    if placa = ElemList.Item(0).Text  = "" then
    	ElemList.Item(0).Text = "Sem Tag"
    end IF
             
    essa é a ideia, mas como não testei não sei se funciona... a ideia do IF é fazer que quando o valor não existir ele coloque um predefinido por você...

    att, Aparecido Deveza



    • Editado Aparecido Deveza quarta-feira, 14 de agosto de 2013 15:10 link
    • Marcado como Resposta Adrhohmann quarta-feira, 14 de agosto de 2013 16:48
    quarta-feira, 14 de agosto de 2013 15:09
  • Vichi!!!

    Perfeito!!

    A ideia do "On Error Resume Next" foi de matar!!!

    Dessa forma nao preciso nem colocar a hora e segundos no nome como solicitei no primeiro post, pois se houver arquivos duplicados, simplesmente ignora e nao trava o script.

    Matou a pau Aparecido..

    Obrigado e fique com DEUS

    quarta-feira, 14 de agosto de 2013 16:51