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 Sub
Con 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
Respuesta de Eduardo Pérez Fernández
1
Respuesta de Jacinto Trillo Jareño
1