USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Dicas

  Visual Basic    (Arquivos/Diretórios)

Título da Dica:  Contar arquivos dentro de uma pasta
Postada em 7/7/2003 por Ronaldão         
'Dim Teste as Long
'Teste = ContarArquivos("c:\windows\", "*.*")

'Caso queira contar arquivos específicos mude o *.* pela extensão desejada _
por exemplo *.bmp e assim por diante

'A API abaixo conta todos os arquivo de uma determinada pasta, informada por você

Private Const INVALID_HANDLE_VALUE = -1
Private Const MAX_PATH = 260
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800

Private Type FILETIME
     dwLowDateTime As Long
     dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
     dwFileAttributes As Long
     ftCreationTime As FILETIME
     ftLastAccessTime As FILETIME
     ftLastWriteTime As FILETIME
     nFileSizeHigh As Long
     nFileSizeLow As Long
     dwReserved0 As Long
     dwReserved1 As Long
     cFileName As String * MAX_PATH
     cAlternate As String * 14
  End Type

Private Type SECURITY_ATTRIBUTES
     nLength As Long
     lpSecurityDescriptor As Long
     bInheritHandle As Long
  End Type

Private Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long

'Para usar a API acima use a seguinte função
Public Function ContarArquivos(Caminho As String, Tipo As String) As Long

   Dim WFD As WIN32_FIND_DATA
   Dim SA As SECURITY_ATTRIBUTES
   Dim r As Long
   Dim hFile As Long
   Dim bNext As Long
   Dim fCount As Long
   Dim currFile As String

   hFile = FindFirstFile(Caminho & Tipo, WFD)

   If (hFile = INVALID_HANDLE_VALUE) Then
       ContarArquivos = 0
       Exit Function
   End If

   If hFile Then
      Do
         fCount = fCount + 1
         bNext = FindNextFile(hFile, WFD)
      Loop Until bNext = 0
   End If

   r = FindClose(hFile)

   ContarArquivos = fCount
End Function
 


CyberWEB Network Ltda.    © Copyright 2000-2024   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página