En poursuivant votre navigation sur ce site, vous acceptez l'utilisation de cookies pour vous proposer des contenus et services adaptés. Mentions légales.

Forum - Problèmes liés à mes codes mis à disposition - Alternative à la fonction Dir2Table


 


le 17/03/2018 : 15:33
par robH

Anonyme

visiteur

Bonjour à tous,

La fonction Dir2Table ne fonctionne plus après Access 2007 (Application.FileSearch plus supporté).

Citation : « http://allenbrowne.com/ser-59.html & https://www.techonthenet.com/access/functions/file/filelen.php »

Après quelques recherche j'ai trouvé ceci : http://allenbrowne.com/ser-59.html et https://www.techonthenet.com/access/functions/file/filelen.php

Sur base de ces deux article et la philosophie de la fonction Dir2Table je vous propose l'adaptation suivante qui visiblement fonctionne très bien sur la version 2016

Les paramètres :

strPath : le répertoire à scanner et importer dans la table strTableName : Le nom de votre table strTblFieldName : Le champs qui recevra le nom des fichiers strTblFieldLength : Le champs qui recevra la taille des fichiers strFileSpec : Filtré le fichiers à remonté (ex "*.pdf" pour ne remonté que les fichier PDF, si non préciser remonte tout les fichiers) bIncludeSubfolders : True/False, inclure les sous répertoire dans le scan

Public Function ListFiles(strPath As String, strTableName As String, strTblFieldName As String, strTblFieldLength As String, Optional strFileSpec As String, Optional bIncludeSubfolders As Boolean)
On Error GoTo Err_Handler
    'Purpose:   List the files in the path.
    'Method:    FilDir() adds items to a collection, calling itself recursively for subfolders.
    Dim colDirList As New Collection
    Dim varItem As Variant
    
    Call FillDir(colDirList, strPath, strFileSpec, bIncludeSubfolders)
    
    'Add the files to table.
     For Each varItem In colDirList
        CurrentDb.Execute "INSERT INTO [" & strTableName & "] " _
                                  & "([" & strTblFieldName & "]," _
                                  & "[" & strTblFieldLength & "])" _
                                  & "SELECT """ & varItem & """," _
                                  & FileLen(varItem) & ";"
    Next
Exit_Handler:
    Exit Function

Err_Handler:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Exit_Handler
End Function

Private Function FillDir(colDirList As Collection, ByVal strFolder As String, strFileSpec As String, _
    bIncludeSubfolders As Boolean)
    'Build up a list of files, and then add add to this list, any additional folders
    Dim strTemp As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant

    'Add the files to the folder.
    strFolder = TrailingSlash(strFolder)
    strTemp = Dir(strFolder & strFileSpec)
    Do While strTemp <> vbNullString
        colDirList.Add strFolder & strTemp
        strTemp = Dir
    Loop

    If bIncludeSubfolders Then
        'Build collection of additional subfolders.
        strTemp = Dir(strFolder, vbDirectory)
        Do While strTemp <> vbNullString
            If (strTemp <> ".") And (strTemp <> "..") Then
                If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then
                    colFolders.Add strTemp
                End If
            End If
            strTemp = Dir
        Loop
        'Call function recursively for each subfolder.
        For Each vFolderName In colFolders
            Call FillDir(colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True)
        Next vFolderName
    End If
End Function

Public Function TrailingSlash(varIn As Variant) As String
    If Len(varIn) > 0& Then
        If Right(varIn, 1&) = "" Then
            TrailingSlash = varIn
        Else
            TrailingSlash = varIn & ""
        End If
    End If
End Function

sujet clos Haut  
Réponse n° 1
--------
le 18/03/2018 : 00:21
par 3Stone

3Stone

Administrateur


Bonjour,

Oui, certaines des fonctions datent d'Access 97, voir avant et les Windows de la même période...

Cordialement,

Pierre (3Stone)

clos par 3Stone le 06/06/2018 : 23:48 Haut  
actif sujet actif   clos sujet clos   Important! Important!   Nouveau Nouveau message
Rectifier Rectifier message   Clôturer Clôturer sujet   Remonter Remonter  
Catégories de discussion  Forum  



Vous êtes ici :   Accueil » Forum » Problèmes liés à mes codes mis à disposition » Alternative à la fonction Dir2Table