** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Access y VBA > Tus Funciones Favoritas & Aportaciones & Artí­culos
  Mensajes nuevos Mensajes nuevos RSS - VBA: FSO - Recursividad. Lista Archivos
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoVBA: FSO - Recursividad. Lista Archivos

 Responder Responder
Autor
Mensaje
genoma111 Ver desplegable
Administrador
Administrador
Avatar

Unido: 28/Marzo/2011
Localización: ...
Estado: Sin conexión
Puntos: 3248
Enlace directo a este mensaje Tema: VBA: FSO - Recursividad. Lista Archivos
    Enviado: 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



Editado por genoma111 - 21/Agosto/2013 a las 10:20
"To VBA or not to VBA... that's the question" DFP
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable