Recorrer tabla para desmarcar los que no están en una carpeta del ordenador
Me descargué una base de datos de internet para cargar un directorio. Básicamente, lo que hace es añadir a una tabla los archivos que tengan en una carpeta.
Estoy intentando optimizarlo para que vaya más rápido, y he añadido un campo a la tabla donde guarda los archivos para marcar con un verdadero/falso si existe o no. Y aquí es donde no sé seguir:
Private Sub SpanFolders(SourceFolderFullName As String, DefaultFolderNumber As Integer, Optional ParentID As Long = 0, Optional ByVal FolderLevel = 0)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True
'Dim FSO As Object 'Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder 'Scripting.Folder
Dim SubFolder As Scripting.Folder 'Scripting.Folder
Dim FileItem As Scripting.File 'Scripting.File
Dim ItemNameClean As String
Dim SourceFolderNameClean As String
' Dim ParentID As Long
Set SourceFolder = FSO.GetFolder(SourceFolderFullName)
' FolderLevel = FolderLevel + 1
SourceFolderNameClean = ReplaceBadCharacters(SourceFolder.Name)
Select Case Nz(DLookup("FolderFileID", "tblFoldersFiles", "FolderFileName='" & SourceFolderNameClean & "'"), 0)
Case 0
LogFilesFolders DefaultFolderNumber, SourceFolderNameClean, SourceFolder. Path, SourceFolder. Type, SourceFolder.Attributes, ParentID, fft_Folder, FolderLevel, True
End Select
' ParentID = GetFolderID(SourceFolder.Path)
For Each FileItem In SourceFolder.Files
ItemNameClean = ReplaceBadCharacters(FileItem.Name)
'If Nz(DLookup("FolderFileID", "tblFoldersFiles", "FolderFileName='" & ItemNameClean & "'"), "") >= 0 Then
' LogFilesFolders DefaultFolderNumber, ItemNameClean, FileItem. Path, FileItem. Type, FileItem.Attributes, ParentID, fft_File, FolderLevel, True
'Else
' CurrentDb.Execute "Update tblFoldersFiles SET Found=False Where FolderFileName='" & ItemNameClean & "'"
'End If
Next FileItem
For Each SubFolder In SourceFolder.SubFolders
ParentID = GetFolderID(SourceFolder.Path) ' The record has just been added so get PK by name
' LogFilesFolders SubFolder. Name, SubFolder. Path, SubFolder. Type, ParentID, fft_Folder, FolderLevel
'If (SubFolder.Attributes And 2) <> 2 And (SubFolder.Attributes And 4) <> 4 Then
SpanFolders SubFolder.Path, DefaultFolderNumber, ParentID, FolderLevel
'End If
Next SubFolder
Set FileItem = Nothing
Set SourceFolder = Nothing
End SubCon ese select case, que más adelante cambiaré a un if, consigo que me añada los nuevos archivos que estén en la carpeta pero no estén registrados en la tabla.
Ahora necesito, como decía antes, que en cada vuelta que de buscando archivos, me vaya marcando los que están en la tabla pero no en la carpeta de archivos.
He probado así:
Private Sub DesmarcarFound(NameClean As String)
Dim TblFiles As DAO.Recordset
Set TblFiles = CurrentDb.OpenRecordset("tblFoldersFiles")
If TblFiles.EOF Then Exit Sub
With TblFiles
Do Until TblFiles.EOF
.Edit
If !FolderFileName = NameClean Then
!Found = True
End If
.Update
.MoveNext
Loop
End With
TblFiles.Close
Set TblFiles = Nothing
End Sub
2 respuestas
Una pregunta antes de seguir mirando:
Si los Registros que te ineresan son los de carpetas existentes:
¿Por qué no borras los registros de la Tabla y comienzas de cero?
Solo te quedarían las carpetas que "SI" están >> Saludos >> JTJ
Hola, Jacinto. Mira, estoy intentando mostrar en un formulario el contenido de tres carpetas, de tal manera que se muestre así:
Esta es la que menos archivos tiene, pero una de ella tiene casi 2000 archivos, que serían 1300 registros. Esto provoca que tarde mucho en cargar el árbol, por no decir que borrar esos registros y volverlos a meter, lo que obliga a compactar la base de datos por la cantidad ingente de registros. Por este motivo es de recorrer el directorio determinando cuáles están o cuáles han sido borrados para desmarcarlos.
¡Muchas gracias por tus comentarios!
Lo acabo de solucionar. Como en la tabla guardo la ruta, solo era cuestión de crear un loop para ir pasando Dir por cada ruta para ver si existía o no, y en este último caso, marcar el campo Found como False.
Private Sub DesmarcarFound()
Dim TblFiles As DAO.Recordset
Set TblFiles = CurrentDb.OpenRecordset("tblFoldersFiles")
If TblFiles.EOF Then Exit Sub
With TblFiles
Do Until TblFiles.EOF
.Edit
Select Case !FileType
Case "Carpeta de archivos"
If Dir(!FolderFileFullName, vbDirectory) = "" Then
!Found = False
Else
!Found = True
End If
Case "Oculto"
!Found = False
Case Else
If Dir(!FolderFileFullName, vbArchive) = "" Then
!Found = False
Else
!Found = True
End If
End Select
.Update
.MoveNext
Loop
End With
TblFiles.Close
Set TblFiles = Nothing
End Sub
Así es, muchas gracias, Jacinto, de nuevo. Un saludo.
Los discípulos siempre acaban superando a los maestros.
Saludos >> JTJ
Revise que no le falte unas comillas en esta línea:
If !FolderFileName = NameClean Then