none
Ajustar Script para copiar arquivo ( VBS ) RRS feed

  • Pergunta

  • Boa tarde,

     

    Este script encontrei aqui no forum, se nao me engano seu criador é Jesiel de Oliveira.

     

    Gostaria de fazer um ajuste mas estou encontrando dificuldades, seque o codigo a seguir a duvida :

     

     

    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
      & "{impersonationLevel=impersonate}\\" & strComputer & "\root\cimv2")
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    'Parte do nome do arquivo que será comum
    strArquivo = "*0002396*.txt"
    
    'PASTA ONDE PROCURAR
    strPasta = "c:\testeorig\"
    
    ShowSubfolders FSO.GetFolder(strPasta)
    showArquivos strPasta
    
    Sub ShowSubFolders(Folder)
      For Each Subfolder in Folder.SubFolders
       showArquivos SubFolder.path
       ShowSubFolders Subfolder
      Next
    End Sub
    
    Sub ShowArquivos(subPasta)
    Set objArq = FSO.GetFolder(subPasta)
    Set MyFiles = objArq.files
    
    For Each MyFiles in objArq.Files
      if instr(Myfiles.name,strArquivo) > 0 Then  
       FSO.CopyFile Myfiles.path , "C:\testedest\" , TRUE
      End if
    Next
    
    End sub

     

    O que ocorre é que eu tenho varios arquivos(dezenas) com o seguinte nome (exemplos - NFE) :

     

    NFE0000015900002439 20100903 142812.TXT

    NFE0002147400002396 20100901 163547.TXT

     

    O IMPORTANTE para mim é o que esta em negrito é nisso que vou me basear para copiar o arquivo, todavia

    existem arquivo com o mesmo nome soh com a extensão diferente (no caso XML), e eu quero somente os TXT.

    Reparem que utilizei no campo ( strArquivo = *0002396*.txt ) para tentar localizar o arquivo, nao esta copiando.

     

    Alem disso tem o detalhe que eu gostaria de deixar que o usuario informasse isso, por que a cada momento do dia

    ele pode querer um arquivo diferente, entao o script teria que pegar o que o usuario informasse *0002396*.txt

    é isso que nao consigo fazer, tentei com get mas nao rolou.

     

    Se alguem puder ajudar ai, agradeço !!

     

     

    T+


    Clansman
    sexta-feira, 3 de setembro de 2010 21:01

Respostas

  • Tente assim.

    strArquivo = InputBox("Digite parte do nome do arquivo que deseja copiar",, "Coloque parte da string sem *")

    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
      & "{impersonationLevel=impersonate}\\" & strComputer & "\root\cimv2")
    Set FSO = CreateObject("Scripting.FileSystemObject")

    'PASTA ONDE PROCURAR
    strPasta = "c:\testeorig\"

    ShowSubfolders FSO.GetFolder(strPasta)
    showArquivos strPasta

    Sub ShowSubFolders(Folder)
      For Each Subfolder in Folder.SubFolders
       showArquivos SubFolder.path
       ShowSubFolders Subfolder
      Next
    End Sub

    Sub ShowArquivos(subPasta)
    Set objArq = FSO.GetFolder(subPasta)
    Set MyFiles = objArq.files

    For Each MyFiles in objArq.Files
      If Not InStr(UCase(myFiles.Name), "XML") > 0 Then
       If InStr(Myfiles.name,strArquivo) > 0 Then 
         FSO.CopyFile Myfiles.path , "C:\testedest\" , TRUE
       End If
      End If
    Next
    End Sub

    Abraço.


    Gabriel Nascimento MCP / MCTS / MCSA / MCSE / CCNA http://gabrielnascimentoit.spaces.live.com -- Se for útil vote.
    • Marcado como Resposta Clansman segunda-feira, 6 de setembro de 2010 18:55
    segunda-feira, 6 de setembro de 2010 18:29

Todas as Respostas

  • Veja se é isso que você precisa e qualquer dúvida poste.

    strArquivo = InputBox("Digite parte do nome do arquivo que deseja copiar",, "Coloque parte da string sem *")

    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
      & "{impersonationLevel=impersonate}\\" & strComputer & "\root\cimv2")
    Set FSO = CreateObject("Scripting.FileSystemObject")

    'PASTA ONDE PROCURAR
    strPasta = "c:\testeorig\"

    ShowSubfolders FSO.GetFolder(strPasta)
    showArquivos strPasta

    Sub ShowSubFolders(Folder)
      For Each Subfolder in Folder.SubFolders
       showArquivos SubFolder.path
       ShowSubFolders Subfolder
      Next
    End Sub

    Sub ShowArquivos(subPasta)
    Set objArq = FSO.GetFolder(subPasta)
    Set MyFiles = objArq.files

    For Each MyFiles in objArq.Files
      if instr(Myfiles.name,strArquivo) > 0 Then 
       FSO.CopyFile Myfiles.path , "C:\testedest\" , TRUE
      End if
    Next

    End sub


    Gabriel Nascimento MCP / MCTS / MCSA / MCSE / CCNA http://gabrielnascimentoit.spaces.live.com -- Se for útil vote.
    sábado, 4 de setembro de 2010 01:13
  • Gabriel,

     

    obrigado pela ajuda, quase ficou OK, acontece que soh posso puxar arquivos com extensão TXT

    e fazendo dessa forma estou trazendo todos os arquivos tanto os TXT quanto os XML... e nao

    podendo usar os " * " fico limitado, acha que pode ser feito algo ?

     

    Obrigado.


    Clansman
    sábado, 4 de setembro de 2010 11:17
  • Tente assim.

    strArquivo = InputBox("Digite parte do nome do arquivo que deseja copiar",, "Coloque parte da string sem *")

    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
      & "{impersonationLevel=impersonate}\\" & strComputer & "\root\cimv2")
    Set FSO = CreateObject("Scripting.FileSystemObject")

    'PASTA ONDE PROCURAR
    strPasta = "c:\testeorig\"

    ShowSubfolders FSO.GetFolder(strPasta)
    showArquivos strPasta

    Sub ShowSubFolders(Folder)
      For Each Subfolder in Folder.SubFolders
       showArquivos SubFolder.path
       ShowSubFolders Subfolder
      Next
    End Sub

    Sub ShowArquivos(subPasta)
    Set objArq = FSO.GetFolder(subPasta)
    Set MyFiles = objArq.files

    For Each MyFiles in objArq.Files
      If Not InStr(UCase(myFiles.Name), "XML") > 0 Then
       If InStr(Myfiles.name,strArquivo) > 0 Then 
         FSO.CopyFile Myfiles.path , "C:\testedest\" , TRUE
       End If
      End If
    Next
    End Sub

    Abraço.


    Gabriel Nascimento MCP / MCTS / MCSA / MCSE / CCNA http://gabrielnascimentoit.spaces.live.com -- Se for útil vote.
    • Marcado como Resposta Clansman segunda-feira, 6 de setembro de 2010 18:55
    segunda-feira, 6 de setembro de 2010 18:29
  • Gabriel,

     

    Muito obrigado.... deu certissimo ! VALEU !


    Clansman
    segunda-feira, 6 de setembro de 2010 18:55