none
VBS para limpar extensões específicas dentro de várias pastas e subpastas RRS feed

  • Pergunta

  • Blz galera!

    Estou tentando fazer uma vbs para limpar uma extensão específica dentro das subpastas "arquivos11" e "arquivos22", conforme exemplo abaixo:

    D:\arquivos1\arquivos11

    D:\arquivos2\arquivos22

    Quer deletar todos arquivos .txt por exemplo dentro destas subpastas.

    Até encontrei um script no link abaixo e o adpatei.

    https://social.technet.microsoft.com/Forums/pt-BR/3f22cec5-2bcb-4016-9d31-3ae7fc862b6b/bat-ou-vbs-para-apagar-arquivos-e-pastas-?forum=scriptadminpt

    Script adaptado:

    Set objNetwork = CreateObject("Wscript.Network")
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    'Coloque aqui a pasta que será verificada
    strPasta1 = "d:\arquivos1"
    strPasta2 = "d:\arquivos2"

    'pastas que serao mantidas
    arrpastas = "arquivos1,arquivos2,arquivos11,arquivos22"

    'pastas que deve apagar apenas o conteúdo
    arrsoCont = "arquivos11,arquivos22"

    arrPastas = Split(arrPastas,",")
    arrsoCont = Split(arrsoCont,",")

    ChecaArquivo strPasta1
    ChecaArquivo strPasta2

    wscript.echo "FIM DO SCRIPT"
    wscript.quit

    Sub ChecaArquivo(strSubPasta)

    Set Folder = ObjFSO.GetFolder(strSubPasta)

    For each subFolder in Folder.SubFolders
       lDeleta = FALSE
       lsoCont = FALSE
       for y = 0 to UBOUND(arrPastas)
          if instr(SubFolder.name,arrPastas(y)) > 0 Then
            lDeleta = TRUE
          End if
       Next
       For z = o to UBOUND(arrsoCont)
          if instr(SubFolder.name,arrsoCont(z)) > 0 Then
            lsoCont = TRUE
          End if  
       Next 


       if lDeleta = FALSE Then
          GeraLog SubFolder.Path
          ChecaArquivo SubFolder.path
          if SubFolder.size = 0 Then
             SubFolder.delete
          End if
       Else

          if lsoCont = TRUE Then
             GeraLog SubFolder.Path
             ChecaArquivo SubFolder.path
          End if
       End if
    Next


    End sub

    '====================================================================

    Sub GeraLog(strCaminho)


    Set objArq = ObjFSO.GetFolder(strCaminho)
    Set MyFiles = objArq.files

    For Each MyFiles in objArq.Files
       strFileOrig = Myfiles.path
       objFSO.deletefile Myfiles.path
    Next
    End sub

    Ele já está limpando as subpastas e mantendo as pastas, sem deletá-las. Mas ele limpa todos os arquivos e não somente as extensões que eu determinar, pois não contém o código para limpar as extensões. Até encontrei alguns códigos vbs na internet para limpar extensões, mas não soube adaptá-los à este script.

    Quem puder me ajudar eu agradeço!

    Abraços

    sexta-feira, 28 de julho de 2017 01:26

Respostas

  • Após algumas adaptações...

    Resolvido!!!

    Dim fldPath1, fldPath2, FSO, File, Folder1, Folder2, filExt

    Set FSO = CreateObject("Scripting.FileSystemObject")
    fldPath1 = ("d:\arquivos1\arquivos11")
    fldPath2 = ("d:\arquivos2\arquivos22")

    If Trim(fldPath1) = "" Then 
        MsgBox "No directory was entered.", vbOKOnly
        WScript.Quit
    Else
        If FSO.FolderExists(fldPath1) Then
            ' Continue program
        Else
            MsgBox "Directory does not exist.", vbOKOnly
            WScript.Quit
        End If
    End If
    If Trim(fldPath2) = "" Then 
        MsgBox "No directory was entered.", vbOKOnly
        WScript.Quit
    Else
        If FSO.FolderExists(fldPath2) Then
            ' Continue program
        Else
            MsgBox "Directory does not exist.", vbOKOnly
            WScript.Quit
        End If
    End If

    Set Folder1 = FSO.GetFolder(fldPath1)
    Set Folder2 = FSO.GetFolder(fldPath2)

    For Each File In Folder1.Files
        If Right(File.name, 4) = ".txt" Then
            FSO.DeleteFile(fldPath1 & "\" & File.name)
        End If
    Next

    For Each File In Folder2.Files
        If Right(File.name, 4) = ".txt" Then
            FSO.DeleteFile(fldPath2 & "\" & File.name)
        End If
    Next

    'MsgBox "Finished..."

    • Marcado como Resposta Daniel-BHZ sexta-feira, 28 de julho de 2017 02:53
    sexta-feira, 28 de julho de 2017 02:53

Todas as Respostas

  • Achei este script na internet que limpa somente extensões específicas, mas não consegui colocar ele para limpar mais de uma pasta de uma vez. 

    Dim fldPath, FSO, File, Folder, filExt

    Set FSO = CreateObject("Scripting.FileSystemObject")
    fldPath = ("d:\arquivos1\arquivos11")

    If Trim(fldPath) = "" Then 
        MsgBox "No directory was entered.", vbOKOnly
        WScript.Quit
    Else
        If FSO.FolderExists(fldPath) Then
            ' Continue program
        Else
            MsgBox "Directory does not exist.", vbOKOnly
            WScript.Quit
        End If
    End If

    Set Folder = FSO.GetFolder(fldPath)

    For Each File In Folder.Files
        If Right(File.name, 4) = ".txt" Or Right(File.name, 4) = ".nk2" Then
            FSO.DeleteFile(fldPath & "\" & File.name)
        End If
    Next

    MsgBox "Finished..."

    Da forma acima ele está funcionando perfeitamente, mas eu precisava que ele limpasse mais de um diretório.

    Tentei assim e não funcionou:

    Dim fldPath, FSO, File, Folder, filExt

    Set FSO = CreateObject("Scripting.FileSystemObject")
    fldPath = ("d:\arquivos1\arquivos11", "d:\arquivos2\arquivos22")

    If Trim(fldPath) = "" Then 
        MsgBox "No directory was entered.", vbOKOnly
        WScript.Quit
    Else
        If FSO.FolderExists(fldPath) Then
            ' Continue program
        Else
            MsgBox "Directory does not exist.", vbOKOnly
            WScript.Quit
        End If
    End If

    Set Folder = FSO.GetFolder(fldPath)

    For Each File In Folder.Files
        If Right(File.name, 4) = ".txt" Or Right(File.name, 4) = ".nk2" Then
            FSO.DeleteFile(fldPath & "\" & File.name)
        End If
    Next

    MsgBox "Finished..."

    sexta-feira, 28 de julho de 2017 02:19
  • Após algumas adaptações...

    Resolvido!!!

    Dim fldPath1, fldPath2, FSO, File, Folder1, Folder2, filExt

    Set FSO = CreateObject("Scripting.FileSystemObject")
    fldPath1 = ("d:\arquivos1\arquivos11")
    fldPath2 = ("d:\arquivos2\arquivos22")

    If Trim(fldPath1) = "" Then 
        MsgBox "No directory was entered.", vbOKOnly
        WScript.Quit
    Else
        If FSO.FolderExists(fldPath1) Then
            ' Continue program
        Else
            MsgBox "Directory does not exist.", vbOKOnly
            WScript.Quit
        End If
    End If
    If Trim(fldPath2) = "" Then 
        MsgBox "No directory was entered.", vbOKOnly
        WScript.Quit
    Else
        If FSO.FolderExists(fldPath2) Then
            ' Continue program
        Else
            MsgBox "Directory does not exist.", vbOKOnly
            WScript.Quit
        End If
    End If

    Set Folder1 = FSO.GetFolder(fldPath1)
    Set Folder2 = FSO.GetFolder(fldPath2)

    For Each File In Folder1.Files
        If Right(File.name, 4) = ".txt" Then
            FSO.DeleteFile(fldPath1 & "\" & File.name)
        End If
    Next

    For Each File In Folder2.Files
        If Right(File.name, 4) = ".txt" Then
            FSO.DeleteFile(fldPath2 & "\" & File.name)
        End If
    Next

    'MsgBox "Finished..."

    • Marcado como Resposta Daniel-BHZ sexta-feira, 28 de julho de 2017 02:53
    sexta-feira, 28 de julho de 2017 02:53