Muito Grato Gere,

estou selencionando os arquivos e tentando implementar o possivel.
até amanha de tarde eu posto 3 arquivos nos quais vamos trabahoar e resolver essa parada logo.
eu sei que é facil pra vc, é mais uma questão de explicar direito e de detalhes, seus sistmas tem muitos detalhes,
o melhor é sintetizar bastante o codigo. Cada hora descubro um codigo num lugar que eu nao sabia que existia, e aí, bagunça minha cabeça.
até amanhã.
abraço.

Olá EdGeres!

vamos por partes então:
A IDEIA AQUI É USAR ESTE MESMO ARQUIVO, TRAZENDO TECNOLOGIA DE OUTRO IMPLEMENTANDO NESTES.

1o- primeiro lugar, alem de visualizador de imagens, ele tbm é para ser um visualizador de arquivos quando vc clicka em mostrar " Todos Formatos" de arquivos em geral, podendo usar o "*.*"
2o- A ideia principal é que o sistema só exiba as 1as pastas, e assim, clickando nelas entrar nas subpastas.
3o - O botão de pesquisar em todas as subpastas precisa arrumar, eu nao sei implementar.
4o- O Botão UP tentei de todo jeito e nao consegui.
5o- Eu adicionei um textbox pra servir de campo onde vai mostrar o endereço inserido pelo botão UP, que nem no seu sistema,
ele fica acima do campo que tem o diretorio raiz.

gosataria que implementasse o codigo pra mim, sempre em FSO. Dá pra tirar de outros arquivos que postei que tem FSO, e adaptar. Este mesmo acho que só tem FSO.

VOU ANEXAR ESSE, DEPOIS ANEXO O PROXIMO.

" https://www.sendspace.com/file/e5i2kz"
https://www.sendspace.com/file/e5i2kz

Eu estou bastante confuso porque viraram dezenas de versões de tentativas nos arquivos.

eu posto abaxo um codigo seu e gostaria de expicação, se ele nao é FSO, tem como substituir por FSO?
----------------------------------------------------------------------------------------------
Sub ListarDIR(strPath As String, LimpaList As Boolean)

Dim strPastaList() As String
Dim lngArrayMax, X As Long
Dim i As Integer

On Error GoTo erro

Application.ScreenUpdating = False

If LimpaList = True Then
Plan1.lstImg.Clear
Plan1.lstSubDir.Clear
Plan1.imgSel.Picture = LoadPicture("")
End If

i = Plan1.lstImg.ListCount

lngArrayMax = 0
strFn = Dir(strPath & "*.*", 23)

While strFn <> ""
If strFn <> "." And strFn <> ".." Then

If (GetAttr(strPath & strFn)) = vbDirectory Then
lngArrayMax = lngArrayMax + 1
ReDim Preserve strPastaList(lngArrayMax)
strPastaList(lngArrayMax) = strPath & strFn & ""
If LimpaList = True Then Plan1.lstSubDir.AddItem strFn
Else
If md_Pasta.VerifExt(strPath & strFn) = True Then
Plan1.lstImg.AddItem strFn
Plan1.lstImg.List(i, 1) = strPath
Plan1.lstImg.List(i, 2) = Format((FileLen(strPath & strFn) / 1024), "##,##0.00") & " KB"
i = i + 1
End If
End If

End If
strFn = Dir()
Wend

If Plan1.ckbTodosDir.Value = True Then
If lngArrayMax <> 0 Then
For X = 1 To lngArrayMax
Call Listar(strPastaList(X), False)
Next
End If
End If

GoTo Fim
erro:
If Err.Number = 5 Then Resume Next

Fim:

Application.ScreenUpdating = True

End Sub

Resumindo, gostaria que copiasse os melhores codigos FSO dos meus arquivos e colocasse nos seus arquivos.
gostaria de fazer o inverso tamém, dos seus, pros meus.

eu acho que apesar do seu estar muito melhor, está congestionado de codigos, prefiro algo mais limpo, porque dá menos manutenção e eu nunca domino os codigos compltemente, vou aprendendo com o tempo.

Oi AdGere!
favor desconsiderar o anexo " FSO-XMAN2-ListDRIVES-v1-ok-teste5.xlsm" (2.64 MiB) Baixado 3 vezes
que postei atras

o anexo que vale é o ultimo que vc postou e posto aqui novamente.
preciso fazer

- botão up
- clickar 2 vezes na pasta e entrar na subpasta.-
- só aparecerem as pastas raiz, só aparecer subpasta se clickar no botao "subdiretorios".

abraço.

Oi AdGere!
favor desconsiderar o anexo " FSO-XMAN2-ListDRIVES-v1-ok-teste5.xlsm" (2.64 MiB) Baixado 3 vezes
que postei atras

o anexo que vale é o ultimo que vc postou e posto aqui novamente.
preciso fazer

- botão up
- clickar 2 vezes na pasta no listbox e entrar na subpasta.-
- só aparecerem as pastas raiz na primeira busca, só aparecer subpasta se clickar no ObtionButton "subdiretorios".
- implementar o textbos em que aparece o caminho completo do arquivo/pasta quando aperto o botao UP.
abraço.

Olá AdGEre!

gosaria que vc implantasse no seu modelo, codigos parecidos com estes (acho que sao mais diretos e mais faceis de manutenção (obs: no meu modelos já tem):
---------------------------------------------------------------------------------------------------
Sub Sample()
ShowFolderList ("C:teste")
End Sub

Sub ShowFolderList(folderspec)
Dim fs, f, f1, fc, s, sFldr
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.SubFolders
For Each f1 In fc
If Right(f1, 1) <> "" Then ShowFolderList f1 & "" Else ShowFolderList f1
Next
Set fc = f.Files
For Each f1 In fc
Debug.Print folderspec & f1.Name

With Worksheets("Control")
Worksheets("Control").ListBox1.AddItem folderspec & f1.Name
End With

Next
End Sub
--------------------------------------------------------------------------------------------

Sub ShowFolderList2(folderspec)
Dim fs, f, f1, fc, s, sFldr
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.SubFolders

For Each f1 In fc
If Right(f1, 1) <> "" Then ShowFolderList2 f1 & "" Else ShowFolderList2 f1
Next

Set fc = f.Files
For Each f1 In fc
Debug.Print folderspec & f1.Name

If Sheets("Visualizador").OptionButton4.Value = True Then GoTo Lancar

Select Case UCase(fs.GetExtensionName(folderspec & f1.Name))
Case "JPG"
If Sheets("Visualizador").optJPG.Value = True Then
GoTo Lancar
Else
GoTo Pular
End If
Case "GIF"
If Sheets("Visualizador").optGIF.Value = True Then
GoTo Lancar
Else
GoTo Pular
End If
Case "BMP"
If Sheets("Visualizador").OptBMP.Value = True Then
GoTo Lancar
Else
GoTo Pular
End If
Case Else
GoTo Pular
End Select

Lancar:
Sheets("Visualizador").ListBox2.AddItem folderspec & "" & f1.Name

Pular:

Next
End Sub

Eu não entendo o seguinte:
como o vba entende que é pra buscar ou restringir uma extensão (*mp3, *jpg, etc)?
o vba possui algum comando pra isso?
porque na minha mente noobe pra saber qual extensao restringir o vba deveria
comparar apenas as ultimas letras depois do último ponto no nome do arquvo,
ou gerar um arquivo fictício e assim comparar se a extensao ficou igual.
ainda assim, sabendo a extensão, nao entendo qual o comando que diz se é pra incluir ou excluir da busca.
esse tem sido o grande problema de eu entender os codigos dos colegas que me ajudam.

pelo explicado abaixo é que eu quero que use a maior parte do meu codigo e simplifique ao maximo, porque pode até funcionar mas nao entendo pra dar manutenção. Vc até pode escolher fazer Functions e chama-las por uma sub, mas eu tenho de entender como um vba entende que é pra incluir ou excluir aquela extensão.

não entendo também:

strFn = Dir(strPath & "*.*", 23)

If (GetAttr(strPath & strFn)) = vbDirectory Then

If md_Pasta.VerifExt(strPath & strFn) = True Then
Plan1.lstImg.AddItem strFn

Olá adGERE,

minha saude nao está nada boa, estou até grogue de tanto remedio,
e achei algumas coisas fora do meu conhecimento,
portanto peço humildemente que implante o que puder, pois, algumas vezes é difici saber onde implantar.
o seu sistema ficou fantastico mas complexo demais pra dar manutenção
eu acho que ainda nao consegui passar minha visão, que é usar o tamanho pequeno dos codigos FSO
e colocar o maximo de coisas nesses codigos, sem ficar colocando em objeto activex,
porque fica uma procura louca achar onde foi colocado o codigo e qual desses codigos alterar.
abraço.

não entendi o que significa

If Plan1.optBMP.Value = True Then
If UCase(fs.GetExtensionName(Arq)) = "BMP" Then
VerifExt = True
--------------------------------------------------------------------------
em especial
If UCase(fs.GetExtensionName(Arq)) = "BMP" Then

BOTOES up
não consigo fazer funcionar:
Private Sub botaoUP_Click()

Dim i As Integer
Dim p As Integer
Dim Caminho As String
dim Plant("vISUALIZADOR").txtDiretorio.Value AS STRING1

Caminho = Trim(Plant.txtDiret(Plant.txtDiretorio.Value)
orio.Value)

If Len(Caminho) > 3 Then
Caminho = Left(Caminho, Len(Caminho) - 1)

p = 3
i = 3
Do
p = InStr(p + 1, Caminho, "")
If p = 0 Then Exit Do
i = p

Loop

Caminho = Left(Caminho, i)
Plan5.txtDiretorio.Value = Caminho
md_Pasta.Listar Plan5.txtDiretorio.Value, True

End If
End Sub

ao tentar implantar o botaoUP,

aparece o seguinte erro;
-Erro de compilação
-Erro de sintaxa

as linhans abaixo aparecem em vermelho:

celulas em vermlho no vbe:
dim Plant("Visualizador").txtDiretorio.Value AS STRING1

Caminho = Trim(Plant.txtDiret(Plant.txtDiretorio.Value)

Olá AdGERE!

quando eu copie o codigo do botao UP do seu arquivo pro meu, deu o segunte erro:
metodo ou membro de dados nao encontrado.
e fiqua ressantado o "txtDiretorio", sendo que eu já criei uma textbox com esse nome pra evitar isso.

tentando transplantar o codigo do potao UP pro meu arquivo dá esse erro:
foi nessa linha: ---- Caminho = Trim("visualizador").txtDiretorio.Value----

"o objeto é obrigatorio"

já tive de mudar varias vezes o codigo e sempre aparece algum problema.

Private Sub botaoUP_Click()

Dim i As Integer
Dim p As Integer
Dim Caminho As String
Dim visualizador As Object

With Sheets("visualizador")
Caminho = Trim("visualizador").txtDiretorio.Value
End With

If Len(Caminho) > 3 Then
Caminho = Left(Caminho, Len(Caminho) - 1)

p = 3
i = 3
Do
p = InStr(p + 1, Caminho, "")
If p = 0 Then Exit Do
i = p

Loop

Caminho = Left(Caminho, i)
Sheets("Visualizador").txtDiretorio.Value = Caminho
md_Pasta.Listar Sheets("Visualizador").txtDiretorio.Value, True

End If
End Sub