none
Script para localizar e mover arquivos RRS feed

  • Pergunta

  • Olá
    Estou com um script que localiza arquivos por extensão e gera um relatório com a localização e o tamanho de cada arquivo, depois no final o espaço em disco ocupado pelos mesmos ( faço isso para localizar arquivos mp3 no meu servidor e ver quanto eles estão consumindo em disco)

    eu gostaria agora de além de localizar os arquivos e gerar o relatório que ele mova os arquivos para um local específico. Se ele poder recriar estrutra de diretórios originais de onde os arquivos foram movidos seria o ideal.

    se alguem poder ajudar fico grato (segue abaixo meu script)


    dim numeroCont,numeroTamanho,nomeComputador,textoNew

    nomeComputador = "."

    numeroCont = 0

    numeroTamanho = 0

    Const ForAppending = 8

    set objetoFSO = CreateObject("Scripting.FileSystemObject")

    systime = Now()

    textoNew = "check-ext.txt"

    'on error resume next

    set objetoSF = objetoFSO.OpenTextFile (textoNew, ForAppending, True)

    Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & nomeComputador & "\root\cimv2")

    Set colFiles = objWMIService.ExecQuery("SELECT * FROM CIM_DataFile where drive = 'D:' and extension ='mp3' or extension ='mpg' or extension ='avi'")

    for each objFile in colFiles

    Set objetoSF2 = objetoFSO.GetFile (objFile.name)

    numeroCont = numeroCont +1

    numeroTamanho = numeroTamanho + cdbl(round(objfile.filesize/1024))

    ArquivoInfo = "Arquivo: " & objfile.name & vbCrLf & "Tamanho :" & cdbl(round(objfile.filesize/1024)) & "Kb" & vbCrLf & "Date last modified:" & objetoSF2.DateLastModified & vbCrLf

    objetoSf.writeline ArquivoInfo

    Next

    objetoSF.writeline ":: Imprime totais ::"

    objetoSF.writeline "Arquivos: " & numeroCont

    objetoSF.writeline "Tamanho: " & numeroTamanho & "Kb"

    objetoSF.writeline ":: Terminou ::"

    objetoSF.close

    terça-feira, 16 de junho de 2009 12:09

Respostas

  • Olá,

    Nao fico triste não... vamos aprender juntos... rsrsrs.

    Testei aqui... realmente estava criando umas pastas erradas...

    Segue agora finalizado ( I hope)

    dim numeroCont,numeroTamanho,nomeComputador,textoNew

    nomeComputador = "."

    numeroCont = 0

    numeroTamanho = 0

    Const ForAppending = 8

    set objetoFSO = CreateObject("Scripting.FileSystemObject")

    systime = Now()

    textoNew = "check-ext.txt"

    'on error resume next

    set objetoSF = objetoFSO.OpenTextFile (textoNew, ForAppending, True)

    Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & nomeComputador & "\root\cimv2")

    Set colFiles = objWMIService.ExecQuery("SELECT * FROM CIM_DataFile where drive = 'D:' and extension ='mp3' or extension ='mpg' or extension ='avi'")

    for each objFile in colFiles

    Set objetoSF2 = objetoFSO.GetFile (objFile.name)

    numeroCont = numeroCont +1

    numeroTamanho = numeroTamanho + cdbl(round(objfile.filesize/1024))

    ArquivoInfo = "Arquivo: " & objfile.name & vbCrLf & "Tamanho :" & cdbl(round(objfile.filesize/1024)) & "Kb" & vbCrLf & "Date last modified:" & objetoSF2.DateLastModified & vbCrLf

    objetoSf.writeline ArquivoInfo



    MoveArquivo objFIle.Name

    Next


    objetoSF.writeline ":: Imprime totais ::"

    objetoSF.writeline "Arquivos: " & numeroCont

    objetoSF.writeline "Tamanho: " & numeroTamanho & "Kb"

    objetoSF.writeline ":: Terminou ::"

    objetoSF.close


    Sub MoveArquivo(arquivo)

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.GetFile(arquivo)

    'DIRETORIO DESTINO DOS ARQUIVOS
    dirdest = "c:\teste2\"

    pastapai = RIGHT(objFile.ParentFolder,LEN(objFile.ParentFolder)-3)

    arrTipos = split(pastapai,"\")

    For x = 0 to UBOUND(arrTipos)
       if objFSO.folderexists(dirdest & arrTipos(x)) = false Then
          objFSO.CreateFolder(dirdest & arrTipos(x))
          dirDest = dirDest & arrTipos(x) & "\"
       Else
          dirDest = dirDest & arrTipos(x) & "\"
       End if
    Next

    objFSO.MoveFile objFile.Path  , dirdest

    End sub


    Faça os testes e nos retorne.

    Até mais,

    Jesiel

    Obs.: Se útil, classifique
    • Marcado como Resposta Fjunior quarta-feira, 24 de junho de 2009 14:10
    terça-feira, 23 de junho de 2009 14:37
  • Olá Jesiel ..
    muito obrigado ficou show agora o script ..
    abaraços
    • Marcado como Resposta Fjunior quarta-feira, 24 de junho de 2009 14:08
    quarta-feira, 24 de junho de 2009 14:07

Todas as Respostas

  • Olá,

    Faça um teste colocando este sub no final do seu script:




    Sub MoveArquivo(arquivo)

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.GetFile(arquivo)

    'DIRETORIO DESTINO DOS ARQUIVOS
    dirdest = "c:\teste2\"

    pastapai = RIGHT(objFile.ParentFolder,LEN(objFile.ParentFolder)-3)

    arrTipos = split(pastapai,"\")

    For x = 0 to UBOUND(arrTipos)
       if objFSO.folderexists(dirdest & arrTipos(x)) = false Then
          objFSO.CreateFolder(dirdest & arrTipos(x))
          dirDest = dirDest & arrTipos(x) & "\"
       End if
    Next

    objFSO.MoveFile objFile.Path  , dirdest

    End sub


    Para chamar o sub, utilize:

    MoveArquivo objFile.name


    Faça os testes e nos retorne.

    Até mais,

    Jesiel

    Obs.: Se útil, classifique
    terça-feira, 16 de junho de 2009 13:56
  • olá Jesiel

    eu fiz como vc indicou  coloquei o sub no fim do script e chamei o sub logo em seguida.

    porém gerou um erro :
    linha 74
    caract.: 1
    Error:ObJeto necessário:'objFile'


    outra coisa que eu notei, quando ele ta gerando o relatório ele nao ta obedecendo a unidade especificada no script ele ta vasculhando todas as uniadades inclusive as unidades de rede mapeadas. se vc puder da uma analizada agradeço.
    o script ficou assim:

    dim numeroCont,numeroTamanho,nomeComputador,textoNew

    nomeComputador = "."

    numeroCont = 0

    numeroTamanho = 0

    Const ForAppending = 8

    set objetoFSO = CreateObject("Scripting.FileSystemObject")

    systime = Now()

    textoNew = "check-ext.txt"

    'on error resume next

    set objetoSF = objetoFSO.OpenTextFile (textoNew, ForAppending, True)

    Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & nomeComputador & "\root\cimv2")

    Set colFiles = objWMIService.ExecQuery("SELECT * FROM CIM_DataFile where drive = 'D:' and extension ='mp3' or extension ='mpg' or extension ='avi'")

    for each objFile in colFiles

    Set objetoSF2 = objetoFSO.GetFile (objFile.name)

    numeroCont = numeroCont +1

    numeroTamanho = numeroTamanho + cdbl(round(objfile.filesize/1024))

    ArquivoInfo = "Arquivo: " & objfile.name & vbCrLf & "Tamanho :" & cdbl(round(objfile.filesize/1024)) & "Kb" & vbCrLf & "Date last modified:" & objetoSF2.DateLastModified & vbCrLf

    objetoSf.writeline ArquivoInfo

    Next

    objetoSF.writeline ":: Imprime totais ::"

    objetoSF.writeline "Arquivos: " & numeroCont

    objetoSF.writeline "Tamanho: " & numeroTamanho & "Kb"

    objetoSF.writeline ":: Terminou ::"

    objetoSF.close

    Sub MoveArquivo(arquivo)

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.GetFile(arquivo)

    'DIRETORIO DESTINO DOS ARQUIVOS
    dirdest = "c:\teste2\"

    pastapai = RIGHT(objFile.ParentFolder,LEN(objFile.ParentFolder)-3)

    arrTipos = split(pastapai,"\")

    For x = 0 to UBOUND(arrTipos)
       if objFSO.folderexists(dirdest & arrTipos(x)) = false Then
          objFSO.CreateFolder(dirdest & arrTipos(x))
          dirDest = dirDest & arrTipos(x) & "\"
       End if
    Next

    objFSO.MoveFile objFile.Path  , dirdest

    MoveArquivo objFile.name

    End sub
     
    MoveArquivo objFile.name
    terça-feira, 16 de junho de 2009 15:21

  • Olá,

    Tenta assim:



    dim numeroCont,numeroTamanho,nomeComputador,textoNew

    nomeComputador = "."

    numeroCont = 0

    numeroTamanho = 0

    Const ForAppending = 8

    set objetoFSO = CreateObject("Scripting.FileSystemObject")

    systime = Now()

    textoNew = "check-ext.txt"

    'on error resume next

    set objetoSF = objetoFSO.OpenTextFile (textoNew, ForAppending, True)

    Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & nomeComputador & "\root\cimv2")

    Set colFiles = objWMIService.ExecQuery("SELECT * FROM CIM_DataFile where drive = 'D:' and extension ='mp3' or extension ='mpg' or extension ='avi'")

    for each objFile in colFiles

    Set objetoSF2 = objetoFSO.GetFile (objFile.name)

    numeroCont = numeroCont +1

    numeroTamanho = numeroTamanho + cdbl(round(objfile.filesize/1024))

    ArquivoInfo = "Arquivo: " & objfile.name & vbCrLf & "Tamanho :" & cdbl(round(objfile.filesize/1024)) & "Kb" & vbCrLf & "Date last modified:" & objetoSF2.DateLastModified & vbCrLf

    objetoSf.writeline ArquivoInfo

    Next

    objetoSF.writeline ":: Imprime totais ::"

    objetoSF.writeline "Arquivos: " & numeroCont

    objetoSF.writeline "Tamanho: " & numeroTamanho & "Kb"

    objetoSF.writeline ":: Terminou ::"

    MoveArquivo objFile.name

    objetoSF.close

    Sub MoveArquivo(arquivo)

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.GetFile(arquivo)

    'DIRETORIO DESTINO DOS ARQUIVOS
    dirdest = "c:\teste2\"

    pastapai = RIGHT(objFile.ParentFolder,LEN(objFile.ParentFolder)-3)

    arrTipos = split(pastapai,"\")

    For x = 0 to UBOUND(arrTipos)
       if objFSO.folderexists(dirdest & arrTipos(x)) = false Then
          objFSO.CreateFolder(dirdest & arrTipos(x))
          dirDest = dirDest & arrTipos(x) & "\"
       End if
    Next

    objFSO.MoveFile objFile.Path  , dirdest

    End sub
     




    Faça os testes e nos retorne.

    Até mais,

    Jesiel

    Obs.: Se útil, classifique
    terça-feira, 16 de junho de 2009 16:27
  • Olá Jesiel.
    desculpe a demora pra responder.

    ainda continua com os mesmos erros. ele está fazendo as consultas em todas as unidades inclusive as de rede e não só na especificada no script

    e ta gerando o mesmo erro: Error:ObJeto necessário:'objFile'
    na linha onde você chama o Sub, no caso a linha 47.


    desde já agradeço a atenção.
    quarta-feira, 17 de junho de 2009 14:39
  • Alguem poderia me ajudar com esse Scritp relatado nos post anteriores ?

    Desde já agradeço !
    sexta-feira, 19 de junho de 2009 14:47
  • Olá,

    Segue abaixo:


    dim numeroCont,numeroTamanho,nomeComputador,textoNew

    nomeComputador = "."

    numeroCont = 0

    numeroTamanho = 0

    Const ForAppending = 8

    set objetoFSO = CreateObject("Scripting.FileSystemObject")

    systime = Now()

    textoNew = "check-ext.txt"

    'on error resume next

    set objetoSF = objetoFSO.OpenTextFile (textoNew, ForAppending, True)

    Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & nomeComputador & "\root\cimv2")

    Set colFiles = objWMIService.ExecQuery("SELECT * FROM CIM_DataFile where drive = 'c:' and extension ='mp3' or extension ='mpg' or extension ='avi'")

    for each objFile in colFiles

    Set objetoSF2 = objetoFSO.GetFile (objFile.name)

    numeroCont = numeroCont +1

    numeroTamanho = numeroTamanho + cdbl(round(objfile.filesize/1024))

    ArquivoInfo = "Arquivo: " & objfile.name & vbCrLf & "Tamanho :" & cdbl(round(objfile.filesize/1024)) & "Kb" & vbCrLf & "Date last modified:" & objetoSF2.DateLastModified & vbCrLf

    objetoSf.writeline ArquivoInfo

    wscript.echo objFIle.Name

    MoveArquivo objFIle.Name

    Next


    objetoSF.writeline ":: Imprime totais ::"

    objetoSF.writeline "Arquivos: " & numeroCont

    objetoSF.writeline "Tamanho: " & numeroTamanho & "Kb"

    objetoSF.writeline ":: Terminou ::"

    objetoSF.close


    Sub MoveArquivo(arquivo)

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.GetFile(arquivo)

    'DIRETORIO DESTINO DOS ARQUIVOS
    dirdest = "c:\teste2\"

    pastapai = RIGHT(objFile.ParentFolder,LEN(objFile.ParentFolder)-3)

    arrTipos = split(pastapai,"\")

    For x = 0 to UBOUND(arrTipos)
       if objFSO.folderexists(dirdest & arrTipos(x)) = false Then
          objFSO.CreateFolder(dirdest & arrTipos(x))
          dirDest = dirDest & arrTipos(x) & "\"
       End if
    Next



    Fiz os testes aqui e funcionou....

    Faça os testes e nos retorne.

    Até mais,

    Jesiel

    Obs.: Se útil, classifique
    sexta-feira, 19 de junho de 2009 17:40
  • E aí Jesiel bão d+....

    Pegando embalo no seus scripts tire uma duvida:


    No caso se eu quisesse procura em uma patas especifica  ex: c:\musicas


    Oq eu teria que modificar?

    vlwsss


    David Dellacenta http://www.andersonpatricio.org http://www.itcentral.com.br
    sexta-feira, 19 de junho de 2009 18:30
  • Olá Jesiel bom dia ..
    eu tive que adicionar um "End Sub" no fim do script pois na hora execução ele gerava um erro "end esperado"
    agora seu script agora não ta gerando erro algum porém ele recriar toda a estrutura de pasta aparece uma "msgbox" com a localizão do arquivo que o script encontrou, porém não ta movendo os arquivos, os mesmos continuam no seu local de origem.
    teria com retirar essa "msgbox" para que todo o procedimento ficasse automatizado ?

    desde já muito obrigado.
    segue o script.

    dim numeroCont,numeroTamanho,nomeComputador,textoNew

    nomeComputador = "."

    numeroCont = 0

    numeroTamanho = 0

    Const ForAppending = 8

    set objetoFSO = CreateObject("Scripting.FileSystemObject")

    systime = Now()

    textoNew = "check-ext.txt"

    'on error resume next

    set objetoSF = objetoFSO.OpenTextFile (textoNew, ForAppending, True)

    Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & nomeComputador & "\root\cimv2")

    Set colFiles = objWMIService.ExecQuery("SELECT * FROM CIM_DataFile where drive = 'd:' and extension ='mp3' or extension ='mpg' or extension ='avi'")

    for each objFile in colFiles

    Set objetoSF2 = objetoFSO.GetFile (objFile.name)

    numeroCont = numeroCont +1

    numeroTamanho = numeroTamanho + cdbl(round(objfile.filesize/1024))

    ArquivoInfo = "Arquivo: " & objfile.name & vbCrLf & "Tamanho :" & cdbl(round(objfile.filesize/1024)) & "Kb" & vbCrLf & "Date last modified:" & objetoSF2.DateLastModified & vbCrLf

    objetoSf.writeline ArquivoInfo

    wscript.echo objFIle.Name

    MoveArquivo objFIle.Name

    Next


    objetoSF.writeline ":: Imprime totais ::"

    objetoSF.writeline "Arquivos: " & numeroCont

    objetoSF.writeline "Tamanho: " & numeroTamanho & "Kb"

    objetoSF.writeline ":: Terminou ::"

    objetoSF.close


    Sub MoveArquivo(arquivo)

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.GetFile(arquivo)

    'DIRETORIO DESTINO DOS ARQUIVOS
    dirdest = "c:\teste2\"

    pastapai = RIGHT(objFile.ParentFolder,LEN(objFile.ParentFolder)-3)

    arrTipos = split(pastapai,"\")

    For x = 0 to UBOUND(arrTipos)
       if objFSO.folderexists(dirdest & arrTipos(x)) = false Then
          objFSO.CreateFolder(dirdest & arrTipos(x))
          dirDest = dirDest & arrTipos(x) & "\"
       End if
    Next
    End Sub
    terça-feira, 23 de junho de 2009 12:04
  • Olá,

    É que eu colei faltando um pedaço... Desculpa...

    Segue o final do SUB: é só substituir o seu... (acho que só falta o objFSO.MoveFile....)



    For x = 0 to UBOUND(arrTipos)
       if objFSO.folderexists(dirdest & arrTipos(x)) = false Then
          objFSO.CreateFolder(dirdest & arrTipos(x))
          dirDest = dirDest & arrTipos(x) & "\"
       End if
    Next

    objFSO.MoveFile objFile.Path  , dirdest

    End sub

    Quanto ao alerta que está apresentando, apague a linha abaixo:


    wscript.echo objFIle.Name


    Faça os testes e nos retorne.

    Até mais,

    Jesiel

    Obs.: Se útil, classifique
    terça-feira, 23 de junho de 2009 12:42
  • Bom dia Jesial agora ta "QUASE" funcionando.. rsrsrsrs (você ja deve ta xateado!!!)

    ele ja ta localizando e movendo os arquivos porém quando o arquivo que ele procura está em sub-pastas ele ta com uma incosistências na hora de recriar a estrutura de pastas e mover os arquivos
    exemplo:

    caminho do arquivo= D:\musicas\dance\musica\aaa.mp3

    destino (onde deve ficar os arquivos movidos)= c:\files

    só que na hora de recriar a estrutura de diretório ele criar assim

    c:\files\musicas\dance\musica\
    c:\files\musica

    ele cria o caminho absoluto e também cria a pasta onde se encontram diretamente os arquivos mp3

    na hora de mover os arquivos ele ta movendo a grande maioria para c:\files e alguns em c:\files\dance\musica e outros ele move para c:\files\musica


    não sei se eu fui claro... se puder ajudar agradeço ...



    terça-feira, 23 de junho de 2009 13:47
  • Olá,

    Nao fico triste não... vamos aprender juntos... rsrsrs.

    Testei aqui... realmente estava criando umas pastas erradas...

    Segue agora finalizado ( I hope)

    dim numeroCont,numeroTamanho,nomeComputador,textoNew

    nomeComputador = "."

    numeroCont = 0

    numeroTamanho = 0

    Const ForAppending = 8

    set objetoFSO = CreateObject("Scripting.FileSystemObject")

    systime = Now()

    textoNew = "check-ext.txt"

    'on error resume next

    set objetoSF = objetoFSO.OpenTextFile (textoNew, ForAppending, True)

    Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & nomeComputador & "\root\cimv2")

    Set colFiles = objWMIService.ExecQuery("SELECT * FROM CIM_DataFile where drive = 'D:' and extension ='mp3' or extension ='mpg' or extension ='avi'")

    for each objFile in colFiles

    Set objetoSF2 = objetoFSO.GetFile (objFile.name)

    numeroCont = numeroCont +1

    numeroTamanho = numeroTamanho + cdbl(round(objfile.filesize/1024))

    ArquivoInfo = "Arquivo: " & objfile.name & vbCrLf & "Tamanho :" & cdbl(round(objfile.filesize/1024)) & "Kb" & vbCrLf & "Date last modified:" & objetoSF2.DateLastModified & vbCrLf

    objetoSf.writeline ArquivoInfo



    MoveArquivo objFIle.Name

    Next


    objetoSF.writeline ":: Imprime totais ::"

    objetoSF.writeline "Arquivos: " & numeroCont

    objetoSF.writeline "Tamanho: " & numeroTamanho & "Kb"

    objetoSF.writeline ":: Terminou ::"

    objetoSF.close


    Sub MoveArquivo(arquivo)

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.GetFile(arquivo)

    'DIRETORIO DESTINO DOS ARQUIVOS
    dirdest = "c:\teste2\"

    pastapai = RIGHT(objFile.ParentFolder,LEN(objFile.ParentFolder)-3)

    arrTipos = split(pastapai,"\")

    For x = 0 to UBOUND(arrTipos)
       if objFSO.folderexists(dirdest & arrTipos(x)) = false Then
          objFSO.CreateFolder(dirdest & arrTipos(x))
          dirDest = dirDest & arrTipos(x) & "\"
       Else
          dirDest = dirDest & arrTipos(x) & "\"
       End if
    Next

    objFSO.MoveFile objFile.Path  , dirdest

    End sub


    Faça os testes e nos retorne.

    Até mais,

    Jesiel

    Obs.: Se útil, classifique
    • Marcado como Resposta Fjunior quarta-feira, 24 de junho de 2009 14:10
    terça-feira, 23 de junho de 2009 14:37
  • Jesiel
    Parabéns seu script ta muito SHow muito obrigado já vou classificar só que tem mais uma coisinha se vc puder me ajudar ficarei muito grato (sou Pidão hauhaua)

    quando eu rodo o script a primeira vez .. blza ele move para local certinho ... agora se o usuário voltar a por o mesmo arquivo no mesmo caminho .. quando eu rodo o script pela segunda vez ele da um erro dizendo que o arquivo já existe . se eu ativo o "on error resume next" ele nao dá o erro mas nao move o arquivo. Teria como fazer que o script, se tiver arquivos com nomes idênticos e caminhos idênticos ele subistitua automáticamente no local de destino ?.



    Desde já muito Obrigado.
    terça-feira, 23 de junho de 2009 15:50
  • Olá,

    Faça os testes no script abaixo:

    dim numeroCont,numeroTamanho,nomeComputador,textoNew
    const deleta = TRUE


    nomeComputador = "."

    numeroCont = 0

    numeroTamanho = 0

    Const ForAppending = 8

    set objetoFSO = CreateObject("Scripting.FileSystemObject")

    systime = Now()

    textoNew = "check-ext.txt"

    'on error resume next

    set objetoSF = objetoFSO.OpenTextFile (textoNew, ForAppending, True)

    Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & nomeComputador & "\root\cimv2")

    Set colFiles = objWMIService.ExecQuery("SELECT * FROM CIM_DataFile where drive = 'D:' and extension ='mp3' or extension ='mpg' or extension ='avi'")

    for each objFile in colFiles

    Set objetoSF2 = objetoFSO.GetFile (objFile.name)

    numeroCont = numeroCont +1

    numeroTamanho = numeroTamanho + cdbl(round(objfile.filesize/1024))

    ArquivoInfo = "Arquivo: " & objfile.name & vbCrLf & "Tamanho :" & cdbl(round(objfile.filesize/1024)) & "Kb" & vbCrLf & "Date last modified:" & objetoSF2.DateLastModified & vbCrLf

    objetoSf.writeline ArquivoInfo



    MoveArquivo objFIle.Name

    Next


    objetoSF.writeline ":: Imprime totais ::"

    objetoSF.writeline "Arquivos: " & numeroCont

    objetoSF.writeline "Tamanho: " & numeroTamanho & "Kb"

    objetoSF.writeline ":: Terminou ::"

    objetoSF.close


    Sub MoveArquivo(arquivo)

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.GetFile(arquivo)

    'DIRETORIO DESTINO DOS ARQUIVOS
    dirdest = "c:\teste2\"

    pastapai = RIGHT(objFile.ParentFolder,LEN(objFile.ParentFolder)-3)

    arrTipos = split(pastapai,"\")

    For x = 0 to UBOUND(arrTipos)
       if objFSO.folderexists(dirdest & arrTipos(x)) = false Then
          objFSO.CreateFolder(dirdest & arrTipos(x))
          dirDest = dirDest & arrTipos(x) & "\"
       Else
          dirDest = dirDest & arrTipos(x) & "\"
       End if
    Next

    wscript.echo dirdest & objFIle.Name
    if objFSO.FileExists(dirdest & objFile.Name) Then
       objFSO.deletefile dirdest & objFile.Name, deleta  
       objFSO.copyfile objFile.Path  , dirdest, deleta
       objFSO.deletefile objFile.path, deleta  
    End if

    End sub


    Faça os testes e nos retorne.

    Até mais,

    Jesiel

    Obs.: Se útil, classifique
    terça-feira, 23 de junho de 2009 16:51
  • Olá Jesiel ..
    muito obrigado ficou show agora o script ..
    abaraços
    • Marcado como Resposta Fjunior quarta-feira, 24 de junho de 2009 14:08
    quarta-feira, 24 de junho de 2009 14:07
  • Boa Dia Jesiel Olha eu aqui de novo. o script funcionou uma maravilha (na minha maquina) quando eu coloquei pra rodar no meu server que tem um disco de 1.5 tera ele gera um erro quando eu mando ele localizar e mover arquivos .mp3 todos os outros tipos de arquivos nao da erro, quando é mp3, eu acho que seja como são muitos arquivos ele deve ta estourando o buffer nao sei .. o erro é esse: line:43 char:1 error:0x80041032 code:80041032 source:(null)
    quarta-feira, 8 de julho de 2009 16:47
  • Bom Dia Jesiel Olha eu aqui de novo. o script funcionou uma maravilha (na minha maquina) quando eu coloquei pra rodar no meu server que tem um disco de 1.5 tera ele gera um erro quando eu mando ele localizar e mover arquivos .mp3 todos os outros tipos de arquivos nao da erro, quando é mp3, eu acho que seja como são muitos arquivos ele deve ta estourando o buffer nao sei .. o erro é esse: line:43 char:1 error:0x80041032 code:80041032 source:(null)
    quarta-feira, 8 de julho de 2009 16:48