Home Excel - Dicas Microsoft Excel VBA Excel VBA - Diretorio Excel planilha vba diretorio listview lista arquivos com icones

Excel planilha vba diretorio listview lista arquivos com icones

E-mail Imprimir PDF

Saberexcel - o site das macros

Esse exemplo de planilha do Aplicativo Microsoft Excel VBA(Visual Basic Application), usando um objeto ListView,  lista os arquivos de determinados diretório, incluindo os ícones de sua extenção, exemplo, excel, pdf, doc, txt, etc..
'procedimentos do objeto listview.

Private Sub UserForm_Initialize()
Dim objShell As Object, objFolder As Object
Dim x As Integer, vNumArquivos As Integer, SecuriteSlash As Integer
Dim vTabela() As String
Dim vDirecao As String, Executable As String

'*****************
Set objShell = CreateObject("Shell.Application") 'procura pelo dir
Set objFolder = objShell.BrowseForFolder(&H0&, "Procurar por um Diretório", &H1&)
On Error Resume Next
vCaminho = objFolder.ParentFolder.ParseName(objFolder.Title).Path
If objFolder.Title = "" Then vCaminho = ""
SecuriteSlash = InStr(objFolder.Title, ":")
If SecuriteSlash > 0 Then vCaminho = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""

If vCaminho = "" Then Exit Sub
'*****************
'listando os arquivos do diretorio
vDirecao = Dir(vCaminho & "\*.*")

Do While Len(vDirecao) > 0
vNumArquivos = vNumArquivos + 1
ReDim Preserve vTabela(1 To vNumArquivos)
vTabela(vNumArquivos) = vDirecao
vDirecao = Dir()
Loop
'*****************
ImageList1.ListImages.Clear

If vNumArquivos > 0 Then

For x = 1 To vNumArquivos
    Executable = FindExecutable(vCaminho & "\" & vTabela(x)) 'procura executavel associado ao arquivo
    ImageList1.ListImages.Add , "A" & x, GetIconFromFile(Executable, 0, False) 'inserindo o icone
Next x

ListView1.SmallIcons = ImageList1

With ListView1
    With .ColumnHeaders
        .Clear
        .Add , , "Nom fichier", 220
        .Add , , "taille", 70
        .Add , , "Date", 70
    End With

For x = 1 To vNumArquivos
.ListItems.Add , , vTabela(x)
.ListItems(x).ListSubItems.Add , , FileLen(vCaminho & "\" & vTabela(x)) & " Bytes"
.ListItems(x).ListSubItems.Add , , Format(FileDateTime(vCaminho & "\" & vTabela(x)), "DD/MM/YYYY")
.ListItems(x).SmallIcon = "A" & x
Next
End With

End If

ListView1.View = 3
Label1 = vCaminho
End Sub

 
DECLARAÇÕES NECESSÁRIAS EM UM MODULO COMUM

Option Explicit

Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As Any, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long
 
Public Declare Function FindExecutableA Lib "shell32.dll" (ByVal lpFile As String, ByVal lpdirectory As String, ByVal lpResult As String) As Long
Public Const MAX_FILENAME_LEN = 256
 
Public Declare Function OleCreatePictureIndirect _
Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, _
ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
 
Public Type PicBmp
   Size As Long
   tType As Long
   hBmp As Long
   hPal As Long
   Reserved As Long
End Type
 
Public Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(7) As Byte
End Type
 
Public Type SHFILEINFO
  hicon As Long
  iIcon As Long
  dwAttributes As Long
  szDisplayName As String * 260
  szTypeName As String * 80
End Type

Public Function GetIconFromFile(FileName As String, IconIndex As Long, UseLargeIcon As Boolean) As IPicture
'*************************************
'Necessita da referencia standard OLE Types
'**************************************
Dim b As SHFILEINFO
Dim retval As Long
Dim pic As PicBmp
Dim IPic As IPicture
Dim IID_IDispatch As GUID
 
retval = SHGetFileInfo(FileName, 0, b, Len(b), &H100)
 
With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With
 
With pic
.Size = Len(b)
.tType = 3 'vbPicTypeIcon
.hBmp = b.hicon
End With
 
Call OleCreatePictureIndirect(pic, IID_IDispatch, 1, IPic)
Set GetIconFromFile = IPic
 
End Function
 
Public Function FindExecutable(S As String) As String
Dim i As Integer
Dim S2 As String

S2 = String(MAX_FILENAME_LEN, 32) & Chr$(0)
i = FindExecutableA(S & Chr$(0), vbNullString, S2)
If i > 32 Then
   FindExecutable = Left$(S2, InStr(S2, Chr$(0)) - 1)
Else
   FindExecutable = ""
End If
    
End Function




 Aprenda tudo sobre o Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel



  DOWNLOAD LIVRE PARA REGISTRADOS
---- Baixe o exemplo de planilha contendo declarações e procedimentos acima
Excel planilha vba diretorio usf listview lista arquivos com icones (71.19 KB)

Última atualização em Sáb, 13 de Agosto de 2011 18:33  

Comentários  

 
# marco antonio montan 09/05/2013 20:18
ola, adquiri os 4 modulos, mas preciso de uma funçao para listar no excel os arquivos de um diretorio, é possivel enviar uma planiha com esta funcionaliade? ou indicar qual das que eu adquiri tem esta funçao?
obrigado
Responder | Responder com citação | Citação
 
 
# Expedito Marcondes x 05/06/2013 09:49
Prezado Marco Antonio,
obrigado mais uma vez pela sua aquisição e por prestigiar nosso trabalho,
Marcos, tenho ótimas planihas para listar as planilhas e criar um link direto
para abrí-las.
Vou enviar para seu endereço de Email.
Quando precisar de alguma coisa, contate-nos,
Fique com Deus,
Expedito Marcondes
Escola Saberexcel VBA Estudos®
Responder | Responder com citação | Citação
 

Adicionar comentário

"Jamais considere seus estudos como uma obrigação, mas como uma oportunidade invejável para aprender a conhecer a influência libertadora da beleza do reino do espírito, para seu próprio prazer pessoal e para proveito da comunidade." Albert Einstein


Código de segurança
Atualizar

Pesquisa Google SaberExcel

Publicidade Google

Publicidade

Rastreamento Correios

Digite o número do SEDEX conforme o exemplo:
Correios do Brasil

Depoimentos

Google Associados

Visitantes SaberExcel

Excel VBA Estudos®
mod_vvisit_countermod_vvisit_countermod_vvisit_countermod_vvisit_countermod_vvisit_countermod_vvisit_countermod_vvisit_counter
mod_vvisit_counterHoje1569
mod_vvisit_counterOntem8239
mod_vvisit_counterEsta Semana30534
mod_vvisit_counterSemana passada44629
mod_vvisit_counterEsse mês155485
mod_vvisit_counterMês passado206275
mod_vvisit_counterTodos6753686
Temos: 34 guests, 19 bots online
Seu IP: 54.211.97.242
 , 
Hoje: Nov 28, 2014
Aprenda MS Excel VBA

Adicione Saberexcel Favoritos

 
 

Aprenda tudo sobre o Aplicativo Microsoft Excel VBA

Aprenda tudo sobre o Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel,


   Sobre as WorksheetFunctions Funções de Planilhas que retornam valores do VBA