none
Deleta arquivo com condição ok mais quando tem mais que um não deleta RRS feed

  • Pergunta

  • Estou precisando de uma ajuda tche, montei um script que que le arquivo e deleta caso ele tenha uma determinada palavra ele deleta o arquivo ate beleza tche ele funciona se na pasta de destino existir somente um arquivo, caso exista mais arquivos da mesma extensão, ele não faz o processo tche.

    codigo.

    Const DeleteReadOnly = True
    strComputer = "."
    
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    
    DIM strArqname
    call GeraLista("C:\Users\mtorres\Desktop\Novapasta","txt, log")
    
     set FSO = createobject("scripting.filesystemobject")
     Set WSHShell = WScript.CreateObject("WScript.Shell")
     set arq = FSO.opentextfile(strArqname,1)
       strTexto = arq.readall
     arq.close
    
     Linhas = Split(strTexto, " ")
    
     For Each strLine in Linhas
     If InStr(strLine, "X44I902") Then
      FSO.DeleteFile(strArqname), DeleteReadOnly
        WScript.quit
     End If
     Next
     
    ' ----------------------------------------------------
    '  Listar txt, log
    ' ----------------------------------------------------
    
    Function GeraLista(strFolderName,strExtensions)
    
     SET objFSO = CREATEOBJECT("Scripting.FileSystemObject")
      IF not objFSO.FolderExists(strFolderName) THEN exit function
       Set colSubfolders = objWMIService.ExecQuery _
        ("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
         & "Where AssocClass = Win32_Subdirectory " _
         & "ResultRole = PartComponent")
       arrFolderPath = Split(strFolderName, "\")
       strNewPath = ""
       For i = 1 to Ubound(arrFolderPath)
        strNewPath = strNewPath & "\\" & arrFolderPath(i)
      Next
     strPath = strNewPath & "\\"
      
     Set colFiles = objWMIService.ExecQuery _
      ("Select * from CIM_DataFile where Path = '" & strPath & "'")
      For Each objFile in colFiles
       if instr(ucase(strExtensions),ucase(objFile.extension)) then
        strarqname = objFile.Name
       End if
      Next
     
      For Each objFolder in colSubfolders
       GetSubFolders strFolderName,strExtensions
      Next
    end function



    • Editado Fábio JrModerator segunda-feira, 28 de janeiro de 2013 22:05 formato do código
    segunda-feira, 28 de janeiro de 2013 18:03

Respostas

  • Esse eu testei e funcionou

    Const DeleteReadOnly = True
    strComputer = "."
    
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    
    DIM strArqname
    call GeraLista("C:\Users\mtorres\Desktop\Novapasta","txt, log")
    
     
    ' ----------------------------------------------------
    '  Listar txt, log
    ' ----------------------------------------------------
    
    Function GeraLista(strFolderName,strExtensions)
    
    	SET objFSO = CREATEOBJECT("Scripting.FileSystemObject")
    	IF not objFSO.FolderExists(strFolderName) THEN exit function
    	Set colSubfolders = objWMIService.ExecQuery _
    		("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
    		& "Where AssocClass = Win32_Subdirectory " _
    		& "ResultRole = PartComponent")
    		
    	arrFolderPath = Split(strFolderName, "\")
    	strNewPath = ""
    	For i = 1 to Ubound(arrFolderPath)
    		strNewPath = strNewPath & "\\" & arrFolderPath(i)
    	Next
    	strPath = strNewPath & "\\"
    
    	Set colFiles = objWMIService.ExecQuery _
    		("Select * from CIM_DataFile where Path = '" & strPath & "'")
    	For Each objFile in colFiles
    		if instr(ucase(strExtensions),ucase(objFile.extension)) then
    			DeletaArquivo objFile.Name
    		End if
    	Next
    
    	For Each objFolder in colSubfolders
    		GetSubFolders strFolderName,strExtensions
    	Next
    end function
    
    Function DeletaArquivo(strArqname)
    
    	set FSO = createobject("scripting.filesystemobject")
    	Set WSHShell = WScript.CreateObject("WScript.Shell")
    	set arq = FSO.opentextfile(strArqname,1)
    	strTexto = arq.readall
    	arq.close
    
    	Linhas = Split(strTexto, " ")
    
    	For Each strLine in Linhas
    		If InStr(strLine, "X44I902") Then
    			wscript.echo "Deletando " & strArqname
    			FSO.DeleteFile(strArqname), DeleteReadOnly
    			
    			exit function
    		End If
    	Next
    
    
    end function


    Fábio de Paula Junior

    • Marcado como Resposta Marcelo TI quarta-feira, 30 de janeiro de 2013 10:48
    terça-feira, 29 de janeiro de 2013 21:31
    Moderador
  • Tentou assim?

    If InStr(strLine, "X44I902") OR InStr(strLine, "X44I925") Then


    Fábio de Paula Junior

    • Marcado como Resposta Marcelo TI quinta-feira, 31 de janeiro de 2013 13:07
    quarta-feira, 30 de janeiro de 2013 14:47
    Moderador

Todas as Respostas

  • Algum amigo tem alguma ideia tche de fazer ele deletar o arquivo mesmo quando tenha outros arquivos com a mesma extensão.
    segunda-feira, 28 de janeiro de 2013 19:01
  • Vc primeiro tem que fazer o loop do arquivo, dentro dele o loop que lê linha a linha.

    Tentei isto mas não testei.

    Const DeleteReadOnly = True
    strComputer = "."
    
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    
    DIM strArqname
    call GeraLista("C:\Users\mtorres\Desktop\Novapasta","txt, log")
    
     
    ' ----------------------------------------------------
    '  Listar txt, log
    ' ----------------------------------------------------
    
    Function GeraLista(strFolderName,strExtensions)
    
    	SET objFSO = CREATEOBJECT("Scripting.FileSystemObject")
    	IF not objFSO.FolderExists(strFolderName) THEN exit function
    	Set colSubfolders = objWMIService.ExecQuery _
    		("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
    		& "Where AssocClass = Win32_Subdirectory " _
    		& "ResultRole = PartComponent")
    		
    	arrFolderPath = Split(strFolderName, "\")
    	strNewPath = ""
    	For i = 1 to Ubound(arrFolderPath)
    		strNewPath = strNewPath & "\\" & arrFolderPath(i)
    	Next
    	strPath = strNewPath & "\\"
    
    	Set colFiles = objWMIService.ExecQuery _
    		("Select * from CIM_DataFile where Path = '" & strPath & "'")
    	For Each objFile in colFiles
    		if instr(ucase(strExtensions),ucase(objFile.extension)) then
    			DeletaArquivo objFile.Name
    		End if
    	Next
    
    	For Each objFolder in colSubfolders
    		GetSubFolders strFolderName,strExtensions
    	Next
    end function
    
    Function DeletaArquivo(strArquivo)
    
    	set FSO = createobject("scripting.filesystemobject")
    	Set WSHShell = WScript.CreateObject("WScript.Shell")
    	set arq = FSO.opentextfile(strArqname,1)
    	strTexto = arq.readall
    	arq.close
    
    	Linhas = Split(strTexto, " ")
    
    	For Each strLine in Linhas
    		If InStr(strLine, "X44I902") Then
    			FSO.DeleteFile(strArqname), DeleteReadOnly
    			WScript.quit
    		End If
    	Next
    
    
    end function


    Fábio de Paula Junior

    segunda-feira, 28 de janeiro de 2013 22:21
    Moderador
  • Ba grande Fabio.

    Obrigado pela ajuda mas desta forma ele da erro na linha 47 column 1.

    Chamada de procedimento ou argumento inválido

    Erro de tempo de execução

    Acesso negado

    a linha 47 é: set arq = FSO.opentextfile(strArqname,1)

    estou rodando como admin da estação tche e no codigo que ue mandei, ele deleta se tiver somente um arquivo na pasta tche, quando tem mais de um com a mesma extensão ou com as duas ele não faz o processo tche.

    terça-feira, 29 de janeiro de 2013 00:05
  • Troca

    Function DeletaArquivo(strArquivo)

    por

    Function DeletaArquivo(strArqname)


    Fábio de Paula Junior

    terça-feira, 29 de janeiro de 2013 00:21
    Moderador
  • Ba Fabiao

    obrigado mais uma vez tche, agora esta deletando, o loop eu tenho que colocar assim tche.

    pois ele esta deletando um por vez, ou seja se o valor estever em um txt e tb no log, ele deleta primerio o txt ai rodo de novo e ele deleta o log.

    Do

    Function DeletaArquivo(strArquivo)

    set FSO = createobject("scripting.filesystemobject")
    Set WSHShell = WScript.CreateObject("WScript.Shell")
    set arq = FSO.opentextfile(strArqname,1)
    strTexto
    = arq.readall
    arq
    .close

    Linhas
    = Split(strTexto, " ")

    For Each strLine in Linhas
    If InStr(strLine, "X44I902") Then
    FSO
    .DeleteFile(strArqname), DeleteReadOnly
    WScript
    .quit
    End If
    Next


    end function

    loop

    terça-feira, 29 de janeiro de 2013 00:46
  • Marcelo,

    Se eu entendi bem então faltou trocar

    WScript.quit

    por

    exit function

    Ficando assim

    Const DeleteReadOnly = True
    strComputer = "."
    
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    
    DIM strArqname
    call GeraLista("C:\Users\mtorres\Desktop\Novapasta","txt, log")
    
     
    ' ----------------------------------------------------
    '  Listar txt, log
    ' ----------------------------------------------------
    
    Function GeraLista(strFolderName,strExtensions)
    
    	SET objFSO = CREATEOBJECT("Scripting.FileSystemObject")
    	IF not objFSO.FolderExists(strFolderName) THEN exit function
    	Set colSubfolders = objWMIService.ExecQuery _
    		("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
    		& "Where AssocClass = Win32_Subdirectory " _
    		& "ResultRole = PartComponent")
    		
    	arrFolderPath = Split(strFolderName, "\")
    	strNewPath = ""
    	For i = 1 to Ubound(arrFolderPath)
    		strNewPath = strNewPath & "\\" & arrFolderPath(i)
    	Next
    	strPath = strNewPath & "\\"
    
    	Set colFiles = objWMIService.ExecQuery _
    		("Select * from CIM_DataFile where Path = '" & strPath & "'")
    	For Each objFile in colFiles
    		if instr(ucase(strExtensions),ucase(objFile.extension)) then
    			DeletaArquivo objFile.Name
    		End if
    	Next
    
    	For Each objFolder in colSubfolders
    		GetSubFolders strFolderName,strExtensions
    	Next
    end function
    
    Function DeletaArquivo(strArquivo)
    
    	set FSO = createobject("scripting.filesystemobject")
    	Set WSHShell = WScript.CreateObject("WScript.Shell")
    	set arq = FSO.opentextfile(strArqname,1)
    	strTexto = arq.readall
    	arq.close
    
    	Linhas = Split(strTexto, " ")
    
    	For Each strLine in Linhas
    		If InStr(strLine, "X44I902") Then
    			FSO.DeleteFile(strArqname), DeleteReadOnly
    			exit function
    		End If
    	Next
    
    
    end function


    Fábio de Paula Junior

    terça-feira, 29 de janeiro de 2013 16:55
    Moderador
  • Ba Fabião

    Assim tche ele deleta os arquivos que tem a informação nas duas extensões tche, porem após deletar e deixa os outros que não tem a informação ele da um erro na linha 39 ( GetSubFolders strFolderName,strExtensions ) Tipos incompatíveis: 'GetSubFolders', posso tratar com On error resume next.

    Outra coisa que tentei tche é que ele busque mais de um valor mais OR e nem o AND ele aceitou na linha If InStr(strLine, ""X44I902") Then

    obrigado.


    • Editado Marcelo TI terça-feira, 29 de janeiro de 2013 18:45 acerto do erro
    terça-feira, 29 de janeiro de 2013 17:36
  • Talvez te ajude até resolver o .vbs

    Powershell

    $Pasta="C:\Users\mtorres\Desktop\Novapasta"
    $Arquivos = dir -path "C:\temp\Nova pasta" -Include @("*.txt","*.log") -Recurse | Select-String "X44I902" 
    $Arquivos | Remove-Item


    Fábio de Paula Junior

    terça-feira, 29 de janeiro de 2013 21:23
    Moderador
  • Esse eu testei e funcionou

    Const DeleteReadOnly = True
    strComputer = "."
    
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    
    DIM strArqname
    call GeraLista("C:\Users\mtorres\Desktop\Novapasta","txt, log")
    
     
    ' ----------------------------------------------------
    '  Listar txt, log
    ' ----------------------------------------------------
    
    Function GeraLista(strFolderName,strExtensions)
    
    	SET objFSO = CREATEOBJECT("Scripting.FileSystemObject")
    	IF not objFSO.FolderExists(strFolderName) THEN exit function
    	Set colSubfolders = objWMIService.ExecQuery _
    		("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
    		& "Where AssocClass = Win32_Subdirectory " _
    		& "ResultRole = PartComponent")
    		
    	arrFolderPath = Split(strFolderName, "\")
    	strNewPath = ""
    	For i = 1 to Ubound(arrFolderPath)
    		strNewPath = strNewPath & "\\" & arrFolderPath(i)
    	Next
    	strPath = strNewPath & "\\"
    
    	Set colFiles = objWMIService.ExecQuery _
    		("Select * from CIM_DataFile where Path = '" & strPath & "'")
    	For Each objFile in colFiles
    		if instr(ucase(strExtensions),ucase(objFile.extension)) then
    			DeletaArquivo objFile.Name
    		End if
    	Next
    
    	For Each objFolder in colSubfolders
    		GetSubFolders strFolderName,strExtensions
    	Next
    end function
    
    Function DeletaArquivo(strArqname)
    
    	set FSO = createobject("scripting.filesystemobject")
    	Set WSHShell = WScript.CreateObject("WScript.Shell")
    	set arq = FSO.opentextfile(strArqname,1)
    	strTexto = arq.readall
    	arq.close
    
    	Linhas = Split(strTexto, " ")
    
    	For Each strLine in Linhas
    		If InStr(strLine, "X44I902") Then
    			wscript.echo "Deletando " & strArqname
    			FSO.DeleteFile(strArqname), DeleteReadOnly
    			
    			exit function
    		End If
    	Next
    
    
    end function


    Fábio de Paula Junior

    • Marcado como Resposta Marcelo TI quarta-feira, 30 de janeiro de 2013 10:48
    terça-feira, 29 de janeiro de 2013 21:31
    Moderador
  • Ba Fabião bom dia

    O outro tb estava meu amigo, eu só gostaria de colocar mais de um valor a ser procurado mas tentei com Or e And tche mais não rolou, ai pensei em uma array colocando os dois valores a ser procurado mais tb da erro tche.

    coloquei assim

    strarry = Array("X44I902","X44I925 ")

    ForEach strLinein Linhas
    IfInStr(strLine, 
    strarry ) Then
                FSO.DeleteFile(strArqname), DeleteReadOnly
    exitfunction
    EndIf
    Next

    Endfunction


    • Editado Marcelo TI quarta-feira, 30 de janeiro de 2013 11:21
    quarta-feira, 30 de janeiro de 2013 10:48
  • Tentou assim?

    If InStr(strLine, "X44I902") OR InStr(strLine, "X44I925") Then


    Fábio de Paula Junior

    • Marcado como Resposta Marcelo TI quinta-feira, 31 de janeiro de 2013 13:07
    quarta-feira, 30 de janeiro de 2013 14:47
    Moderador
  • Ba Fabião

    Trilegal tche, valeu...

    quinta-feira, 31 de janeiro de 2013 13:07