Notifications
Clear all

visualizador Imagens FSO Recursiva

77 Posts
4 Usuários
0 Reactions
10.7 K Visualizações
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

Olá colegas!
bom domingo!

deejo fazer um visualizador de Imagens Excel usando FSO (FileSystemObject)
recursiva em todos os codigos.
o primeiro desafio é listar os arquivos ou pastas com subpastas no Listbox.
lembrando sempre usar FSO recursiva.

eu consegu listar a primeira subpasta, mas nao tá puxando as outras.
meu prolema é listar todas as subpastas e os arquivos delas paradamente em um listbox pra cada.
eu configurei pra buscar e (c:teste) e incluí no arquivo de exemplo.
incluí no arquivo excel a tela de como deve ficar no final o visualizador de imagens.
eu tenho um visualizador de SKINS em vb6 que dá pra tirar o codigo mas nao sei como edita-lo.
grato.

 
Postado : 12/07/2015 8:16 am
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

Olá ADGere,

consegui implementar as novas mudanças.

fiz o botao TodosDiretorios funcionar, só nao sei se está certo mesmo.

agora falta implementar:
-botao UP
_ Visualizar as imagens ao clickar na listibox

 
Postado : 17/07/2015 11:08 pm
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

O botão TodosOsDiretorios nao funciona, nao mostra todos os arquivos (existe um .txt na pasta teste)

tentei fazer assim, mas nao funcionou:
-------------------------------------------------------------------------------------------------------
Select Case UCase(fs.GetExtensionName(folderspec & f1.Name))
Case "JPG"
If Sheets("Visualizador").optJPG.Value = True Or _
Sheets("Visualizador").OptionButton4.Value = True Or _
Sheets("Visualizador").OptionButton5.Value = True Then
GoTo Lancar
Else
GoTo Pular
End If
Case "GIF"
If Sheets("Visualizador").optGIF.Value = True Or _
Sheets("Visualizador").OptionButton4.Value = True Or _
Sheets("Visualizador").OptionButton5.Value = True Then
GoTo Lancar
Else
GoTo Pular
End If
Case "BMP"
If Sheets("Visualizador").OptBMP.Value = True Or _
Sheets("Visualizador").OptionButton4.Value = True Or _
Sheets("Visualizador").OptionButton5.Value = True Then
GoTo Lancar
Else
GoTo Pular
End If
Case Else
GoTo Pular
End Select

 
Postado : 17/07/2015 11:27 pm
(@adgere)
Posts: 76
Trusted Member
 

Veja o anexo

 
Postado : 17/07/2015 11:49 pm
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

Olá AdGere.
Mais uma vez voce foi fantastico!!!

ficou faltando

o Botao Maostrar TodosDiretorios
e o botão UP.

eu vou ralar pra ver se consigo, mas já estou esgotado mexendo nesse sistema há uns 4 dias.
abraço.

 
Postado : 18/07/2015 7:41 am
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

Olá AdGERE!

percebi que meu codigo pra subpastas está errado,
pois nao permitque que ao clikcar na pasta "entre" dentro da sua respectiva subpastas.
também tentei o botão Up e ainda nao deu certo.

eu gostaria que vc implantasse o que vc fez no seu sitema, no meu sistema,
preservando ao maximo o meu codigo, e alterando onde for necessario.
eu acho que o FSO é muito menor e mais simples de modificar.
grato.

 
Postado : 18/07/2015 8:35 am
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

Ola ADGEre!

gostaria que vc implantasse o componente "TXTdiretorio",
pois deixar o outro campo só com o Driver Raiza quieto é melhor.
nesse é "TXTdiretorio", que deve aparecer a navegação entre as pastas .

ou seja, quero tudo o que tem no seu sistema, mas preservando ao maximo o meu codigo
porque aí fica facil pra eu endenter e altear.

 
Postado : 18/07/2015 8:45 am
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

Codigos dando Erro.- BOTAO UP

Private Sub CommandButton1_Click()

Dim i As Integer
Dim p As Integer
Dim Caminho As String

Caminho = Trim(Plan5.txtDiretorio.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
MóduloPesquisa.Listar_arquivos Plan5.txtDiretorio.Value

End If

End Sub

--------------------------------------------------------------------------------------------------
erro aqui: "md_Drive.Lista"

Private Sub Workbook_Open()

Plan5.ckbTodosDir.Value = False

md_Drive.Lista
Sheets(Plan5).txtDiretorio.Value = Sheets(Plan5).CBOdRIVE.Value
MóduloPesquisa.Listar_arquivos Sheets(Plan5).txtDiretorio.Value

End Sub

 
Postado : 18/07/2015 12:01 pm
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

o arquivo anexo nao quer subir, tá dando erro.

 
Postado : 18/07/2015 12:15 pm
(@adgere)
Posts: 76
Trusted Member
 

O erro deve ser

Sheets(Plan5)

Quando você utiliza Sheets() o que vai dentro do parentes deve estar com aspas..

se você colocar plan5 apenas não precisa

Plan5.txtDiretorio.Value

 
Postado : 18/07/2015 2:23 pm
(@adgere)
Posts: 76
Trusted Member
 

qualquer coisa mande o arquivo como esta...

 
Postado : 18/07/2015 2:27 pm
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

Private Sub Workbook_Open()

Plan5.ckbTodosDir.Value = False

md_Drive.Lista
Plan5.txtDiretorio.Value = Plan5.CBOdRIVE.Value
MóduloPesquisa.Listar_arquivos Plan5.txtDiretorio.Value

End Sub

 
Postado : 18/07/2015 2:30 pm
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

O arquivo está com 8mb descompactado e talvez por isso, mesmo compacatado o forum nao tá aceitando.
estou tentando anexar em outro site.

Olá ADGere, até agora voce foi fantastico comigo
mas eu gostaria de que vc fizesse 2 tentativas:
1a.-colocar os meus codigos no seu exemplo.
2a-colocar os seus codigos alterados pra FSO no meu sistema.
o seu sistema possui alguns extrax que o meu nao possui, como aquela barra inicial do endereço que serve pro UP.
e quando ckicka na pasta ela entra pras subpastas.
o meu codigo nao permite entrar em subpastas.
só que eu gosto mais dos meus codigos em FSO porque sao menores e mais simples.
vc pode deletar a vontade os modulos desnecessarios ou renomea-los pra distiguir daqueles que estamos trabalhando.

Link do Arquivo:
" https://www.sendspace.com/file/2ek58m"
" https://www.sendspace.com/file/2ek58m"

-------------------------------------------------------------------------------------------
dá erro em -----md_Drive.Lista.------ è o unico lugar que vi esse md_drive, portanto, é estranho.
-------------------------------------------------
Private Sub Workbook_Open()

Plan5.ckbTodosDir.Value = False

md_Drive.Lista
Plan5.txtDiretorio.Value = Plan5.CBOdRIVE.Value
MóduloPesquisa.Listar_arquivos Plan5.txtDiretorio.Value

End Sub

 
Postado : 18/07/2015 2:42 pm
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

eu coloquei o seguinte codigo no botao UP que nao faz nada:
-----------------------------------------------------------------------
Private Sub cmdUp_Click()

Dim i As Integer
Dim p As Integer
Dim Caminho As String

Caminho = Trim(Plan5.txtDiretorio.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
MóduloPesquisa.Listar_arquivos Plan5.txtDiretorio.Value

End If

End Sub

 
Postado : 18/07/2015 2:47 pm
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

Olá adGere!!!
boa noite!

estou muito confuso porque acabou ficando muitos arquivos com configurações diferentes pra eu testar 1 por 1.
um tem uma coisa que o outro nao tem
então, eu gostaria de combinar com voce pra trabalharmos em cima de 3 arquivos, 3 exemplos, pra ver no final qual vai ficar melhor.

por exemplo, a estrutura e funcionamento do seu arquivo é melhor que o meu, mas o meu está todo em FSO e compacto o codigo.

então, eu gostaria de transferir parte do meu codigo pros seus modelos, e parte dos codigos e estrutura do seu modelo pros meus.

creio que dessa forma mataremos mais rapido esse caso.
abraço.

 
Postado : 18/07/2015 3:58 pm
(@adgere)
Posts: 76
Trusted Member
 

Xman,

Por mim tranquilo... mas acho q você tem que montar o arquivo ai.. da forma que acha melhor.. e as duvidas que vão surgindo vai postando...

 
Postado : 18/07/2015 5:44 pm
Página 4 / 6