Notifications
Clear all

visualizador Imagens FSO Recursiva

77 Posts
4 Usuários
0 Reactions
10.6 K Visualizações
(@xman2000)
Posts: 0
New 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: 0
New 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: 0
New 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: 0
New Member
 

Veja o anexo

 
Postado : 17/07/2015 11:49 pm
(@xman2000)
Posts: 0
New 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: 0
New 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: 0
New 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: 0
New 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: 0
New Member
Topic starter
 

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

 
Postado : 18/07/2015 12:15 pm
(@adgere)
Posts: 0
New 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: 0
New Member
 

qualquer coisa mande o arquivo como esta...

 
Postado : 18/07/2015 2:27 pm
(@xman2000)
Posts: 0
New 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: 0
New 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: 0
New 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: 0
New 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: 0
New 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