CICLO WHILE

Citação:

:
Modulo:

[ô]Variaveis gerais
Public fso As New FileSystemObject [ô]Declaração do Microsoft Script Runtime (Procura os arquivos nas pastas)

Public lonDiretorios As Long
Public lonArquivos As Long

[ô]BUSCA OS ARQUIVOS NAS PASTAS
Public Function fncProcuraArquivo(ByVal strPasta As String, strArquivo As String, lonDiretorios As Long, lonArquivos As Long) As Currency
On Error GoTo Catch
Dim tPasta As Folder, tArquivo As File, strNomeArquivo As String
Set Fld = fso.GetFolder(strPasta)
[ô]PROCURA SOMENTE EM DIRETÓRIOS DIFERENTES DE TEMPORARY INTERNET FILES
If InStr(strPasta, [Ô]Temporary Internet Files[Ô]) = 0 Then
strNomeArquivo = Dir(fso.BuildPath(Fld.Path, strArquivo), vbNormal Or vbHidden Or vbSystem Or vbReadOnly)
[ô]While Len(strNomeArquivo) <> 0 Or strNomeArquivo <> [Ô][Ô]
While strNomeArquivo <> [Ô][Ô]
fncProcuraArquivo = fncProcuraArquivo + FileLen(fso.BuildPath(Fld.Path, strNomeArquivo))
lonArquivos = lonArquivos + 1

[ô]GUARDA A EXTENSÃO SOMENTE QUANDO FOR UM DISCO REMOVIVEL
If (strNomeArquivo <> [Ô][Ô]) Then

End If






[ô]GRAVA O ARQUIVO NO TXT
[ô]If intTimeOutArquivo < 6 Then
MsgBox fso.BuildPath(Fld.Path, strNomeArquivo)
[ô]Print #strRI, fso.BuildPath(Fld.Path, strNomeArquivo)
[ô]strCarregaArquivosEncontrados = strCarregaArquivosEncontrados & Fld.Path & strNomeArquivo & vbCrLf
[ô]Close #strRI
[ô]strTimeOutArquivo = fso.BuildPath(Fld.Path, strNomeArquivo)
[ô]End If


[ô]BUSCA NOVO ARQUIVO
strNomeArquivo = Dir()
DoEvents
Wend
End If
lonDiretorios = lonDiretorios + 1
If Fld.SubFolders.Count > 0 Then
For Each tPasta In Fld.SubFolders
DoEvents
fncProcuraArquivo = fncProcuraArquivo + fncProcuraArquivo(tPasta.Path, strArquivo, lonDiretorios, lonArquivos)
Next
End If
Exit Function
Catch:
FileName = [Ô][Ô]
Resume Next
End Function

FORM:
Call fncProcuraArquivo([Ô]c:[Ô], [Ô]*.txt[Ô], lonDiretorios, lonArquivos)

O código está meio sujo, mas está funcionando....testa ai....