Imprimir página | Cerrar ventana

VBA: FSO - Recursividad. Lista Archivos

Impreso de: Foro de Access y VBA
Categoría: Access y VBA
Nombre del foro: Tus Funciones Favoritas & Aportaciones & Artí­culos
Descripción del foro: Para publicar código interesante, aportaciones y artículos
URL: http://www.mvp-access.com/foro/forum_posts.asp?TID=77384
Fecha de impresión: 17/Febrero/2020 a las 04:18


Tema: VBA: FSO - Recursividad. Lista Archivos
Publicado por: genoma111
Asunto: VBA: FSO - Recursividad. Lista Archivos
Fecha de publicación: 20/Agosto/2013 a las 23:34
En este ejemplo uso "File System Object" para recorrer las carpetas y subcarpetas obteniendo los nombres de archivos y sus tipos, usando recursividad.

Los datos obtenidos los inserto en una tabla temporal que creo acá mismo para dicho fin.

Uso:

Private Sub Command0_Click()
    Dim strPath         As String
   
    CreateTemporalTable "TablaTemporal", " Ruta CHAR," & _
                                         " Subcarpeta CHAR," & _
                                         " Archivo CHAR," & _
                                         " Tipo CHAR"
    ' Establecemos la ruta
    strPath = "C:\Users\genoma111\Documents\"
   
    ListaArchivos (strPath)
   
    MsgBox "Listo el pollo"
End Sub

Sub que recorre las carpetas y archivos e inserta los datos en la tabla temporal:

'---------------------------------------------------------------------------------------------------------------------------------------
' Nombre:       ListaArchivos
' Propósito:    Lista todos los archivos a partir de un directorio inicial.
' Descripción:  strPath = Ruta inicial.
' Author:       Diego F.Pereira-Perdomo
' Date:         Jun-05-2013
'---------------------------------------------------------------------------------------------------------------------------------------
Public Sub ListaArchivos(strPath As String)
' En el menú Tools hacemos click en la opción Referencias y añadimos
' la librería Microsoft Scripting Runtime

    Dim dbs             As DAO.Database
    Dim oFSO            As New FileSystemObject
    Dim oFolder         As Folder
    Dim oSubFolder      As Folder
    Dim oFile           As File
    Dim strSQL          As String
       
    Set dbs = CurrentDb
   
    Set oFolder = oFSO.GetFolder(strPath)
   
        For Each oFile In oFolder.Files

            strSQL = "Insert Into TablaTemporal" & _
                    " (Ruta, Subcarpeta, Archivo, Tipo)" & _
                    " Values" & _
                    " ('" & oFile.path & "'," & _
                    " '" & oFolder.Name & "'," & _
                    " '" & oFile.Name & "'," & _
                    " '" & oFile.Type & "')"

            dbs.Execute strSQL

        Next oFile
   
    For Each oSubFolder In oFolder.SubFolders
        ListaArchivos (oSubFolder.path)
    Next oSubFolder
   
    Set oFolder = Nothing
    Set dbs = Nothing
End Sub

Función que revisa si existe la tabla temporal

Public Function TableExists(strTable As String) As Boolean

    Dim dbs As DAO.Database
    Dim tbl As TableDef
    Dim boo As Boolean
   
    Set dbs = CurrentDb
   
    boo = False
    For Each tbl In dbs.TableDefs
        If tbl.Name = strTable Then
            boo = True
        End If
    Next tbl
   
    TableExists = boo
   
    Set dbs = Nothing
End Function

Función que limpia la tabla

Public Function DeleteTableContents(strTable As String) As Boolean

    Dim dbs As DAO.Database
    Dim strSQL As String
    Dim boo As Boolean
   
    Set dbs = CurrentDb
    boo = False
   
    If TableExists(strTable) Then
        strSQL = "Delete * From " & strTable
        dbs.Execute strSQL
        boo = True
    End If
   
    DeleteTableContents = boo
   
    Set dbs = Nothing
End Function

Sub que crea la tabla temporal

Public Sub CreateTemporalTable(strTable As String, _
                     Nombres_TipoCampos As String)

    Dim dbs As DAO.Database
    Dim strSQL As String
   
    Set dbs = CurrentDb
   
    If DeleteTableContents(strTable) Then

    Else
        strSQL = "Create Table TablaTemporal(" & Nombres_TipoCampos & ")"
       
        dbs.Execute strSQL
       
        dbs.TableDefs.Refresh
        Application.RefreshDatabaseWindow
    End If
   
    Set dbs = Nothing
End Sub



-------------
"To VBA or not to VBA... that's the question" DFP



Imprimir página | Cerrar ventana