Macro para fazer um "DIR /S" (Traz os arquivos da pasta atual e subpastas)

Question

Criei uma macro para listar os arquivos da pasta atual e subpastas (abaixo).

Para isso, usei um recurso de executar um comando externo do DOS (DIR) e o resultado eu diria ficou satisfatório...

Ocorre que se abro uma janela do DOS (Iniciar / CMD) e executo o comando DIR, a lista dos arquivos pode ser lida normalmente. Entretanto, ao gerar a resposta para um arquivo ">dir.txt" o mesmo fica ilegível, com "sujeira" na acentuação...

Acredito que seja um problema de "Página de código do dispositivo CON e PRT" ?

Enfim, gostaria de ajuda para sanar este problema... grato!

Espero que seja útil, eu uso muuuito!

OBS - A macro precisa apenas estar num arquivo com planilha de nome "MENU".

OBS2 - É interessante observar que após o comando DOS (Shell) é necessário "gerar" um delay para que o arquivo TXT seja gerado, pois caso contrário a velocidade de execução da macro impossibilita a leitura completa do arquivo gerado ("dir.txt"), que é excluído ao final.

Sub M1_LEPASTA_DIR()

Dim MyPath, MyName As String

Dim MyLine As Integer

MyLine = 6

MyPath = Cells(3, 1)

'Executa comando DOS

Shell "cmd /c dir " & MyPath & "*.* /x /s >" & MyPath & "dir.txt"

Application.Wait (Now + TimeValue("0:00:05"))

'Apaga pasta e arquivos atuais

Range("A6:B1048576").Select

Selection.ClearContents

'Leitura do arquivo "dir.txt"

Open Worksheets("MENU").Cells(3, 1).Value & "dir.txt" For Input As #1

Do While Not EOF(1)

Line Input #1, MyName

If InStr(1, MyName, " Pasta de ") Then

MyPath = Mid(MyName, 11, 99) & ""

ElseIf InStr(1, MyName, "<DIR>") <> 22 Then

MyName = Mid(MyName, 50, 199)

If MyName <> "" Then

Cells(MyLine, 1) = MyPath

Cells(MyLine, 2) = MyName

MyLine = MyLine + 1

End If

End If

Loop

Close #1

Cells(MyLine - 1, 1) = ""

Cells(MyLine - 1, 2) = ""

Kill Worksheets("MENU").Cells(3, 1).Value & "dir.txt"

Range("A6").Select

End Sub

Answer 1

Olá MLRamos,

Para questões sobre VBA, poste sua dúvida no link abaixo:

http://social.msdn.microsoft.com/Forums/pt-br/home?forum=vbapt

Até mais!!!