SCRIPT DE BUSCA E ERROR 70 - PERMISSION DENIED

DANLEONHART 25/09/2011 10:11:26
#385191
Seguinte...

Tenho um script que faz uma busca no sistema todo...em um TextBox coloco o nome (ou parte do nome) do arquivo e ao clicar em um botão, lista-se em um ListView todos arquivos encontrados no sistema...o que tá ocorrendo é que se durante a busca ele se depara com uma pasta onde não há permissão de acesso (erro Runtime 70 - Permissão Negada.), ele encerra a busca e só lista os arquivos encontrados até o momento do erro...gostaria que ao encontrar a pasta com o acesso negado, ele a pulasse e seguisse para a próxima...

segue script:


Sub Lista_Busca()
   [ô] Procura arquivo em diretório especificado:
Dim Obj_Pst As Folder, Lst As ListItem
Dim v_Cam As String, vTa As Integer

vTa = Len(txt2.Text)
v_Proc = LCase(txt2.Text)
v_Cam = txt1.Text
If txt2.Text = Empty Then
 Exit Sub
ElseIf txt1.Text = Empty Then
 MsgBox [Ô]Informe a pasta...[Ô], vbInformation
 txt1.SetFocus
 Exit Sub

End If
Pb1.Min = 0
Pb1.Value = 0
Set Obj_Pst = FSO.GetFolder(v_Cam)

With Lv1.ColumnHeaders
          .Clear
          .Add , , [Ô]Nome[Ô], 2000, 0
          .Add , , [Ô]Caminho[Ô], 4000, 0
          .Add , , [Ô]Atributo(s)[Ô], 3000, 0
End With

Lv1.ListItems.Clear

  For Each Arq In Obj_Pst.Files
    If LCase(Mid(Arq.Name, 1, vTa)) = v_Proc Then
       
       Set Lst = Lv1.ListItems.Add(, , Arq.Name, v_Icon(Arq.Name), v_Icon(Arq.Name))
                   Lst.SubItems(1) = Arq.Path
                   Lst.SubItems(2) = Arq.Attributes
    End If
  Next

  For Each Obj In Obj_Pst.SubFolders
  
    Set PST = FSO.GetFolder(Obj)
    
      For Each Arq2 In PST.Files
      
         If LCase(Mid(Arq2.Name, 1, vTa)) = v_Proc Then
          
           
           Set Lst = Lv1.ListItems.Add(, , , v_Icon(Arq2.Name), v_Icon(Arq2.Name))
               Lst.Text = Arq2.Name
               Lst.SubItems(1) = Arq2.Path
               Lst.SubItems(2) = Arq2.Attributes
            
         End If
      Next
   Next

LbLst.Caption = Lv1.ListItems.Count & [Ô] Arquivo(s)[Ô]

End Sub
DANLEONHART 26/09/2011 07:16:51
#385220
é isso mesmo que causa a interrupção da pesquisa...
ROBIU 26/09/2011 12:59:02
#385259 Resposta escolhida
Como você não postou o projeto, não dá para testar. Segue um projeto que lista os arquivos e dá o erro, só que com um listbox.
DANLEONHART 27/09/2011 22:55:14
#385433
Vou tentar adaptar ao meu...
Valeu !
MARCELO.TREZE 28/09/2011 00:36:44
#385437
vc tentou apenas um resume onde ocorreo erro

exemplo

Sub Lista_Busca()
[txt-color=#0000f0]On Error Resume Next[/txt-color]
[ô] Procura arquivo em diretório especificado:
Dim Obj_Pst As Folder, Lst As ListItem
Dim v_Cam As String, vTa As Integer

vTa = Len(txt2.Text)
v_Proc = LCase(txt2.Text)
v_Cam = txt1.Text
If txt2.Text = Empty Then
Exit Sub
ElseIf txt1.Text = Empty Then
MsgBox [Ô]Informe a pasta...[Ô], vbInformation
txt1.SetFocus
Exit Sub

End If
Pb1.Min = 0
Pb1.Value = 0
Set Obj_Pst = FSO.GetFolder(v_Cam)

With Lv1.ColumnHeaders
.Clear
.Add , , [Ô]Nome[Ô], 2000, 0
.Add , , [Ô]Caminho[Ô], 4000, 0
.Add , , [Ô]Atributo(s)[Ô], 3000, 0
End With

Lv1.ListItems.Clear

For Each Arq In Obj_Pst.Files
If LCase(Mid(Arq.Name, 1, vTa)) = v_Proc Then

Set Lst = Lv1.ListItems.Add(, , Arq.Name, v_Icon(Arq.Name), v_Icon(Arq.Name))
Lst.SubItems(1) = Arq.Path
Lst.SubItems(2) = Arq.Attributes
[txt-color=#0000f0]Resume[/txt-color]
End If
Next

For Each Obj In Obj_Pst.SubFolders

Set PST = FSO.GetFolder(Obj)

For Each Arq2 In PST.Files

If LCase(Mid(Arq2.Name, 1, vTa)) = v_Proc Then


Set Lst = Lv1.ListItems.Add(, , , v_Icon(Arq2.Name), v_Icon(Arq2.Name))
Lst.Text = Arq2.Name
Lst.SubItems(1) = Arq2.Path
Lst.SubItems(2) = Arq2.Attributes
[txt-color=#0000f0] Resume[/txt-color]
End If
Next
Next

LbLst.Caption = Lv1.ListItems.Count & [Ô] Arquivo(s)[Ô]

End Sub
DANLEONHART 28/09/2011 07:15:30
#385442
Valeu pessoal !

Vou testar assim que chegar do trabalho !
Tópico encerrado , respostas não são mais permitidas
Voltar