Discussion :

[iFitch]

Bonjour à tous,

Je suis nouveau ici, et en plein projet de base de données pour mon stage.

Petit topo rapide:
En gros le chef de projet veut pouvoir lier des fichiers (word, excel, etc...) aux propositions stoquées dans la base de données.

Les liens consistent uniquement en un Nom de fichier, un lien, et la reference de la proposition. Dans l'idée il voulait faire du drag and drop de fichiers sur une zone du formulaire avec recuperation des infos...Apres pas mal de recherche a droit a gauche, ca avait pas l'air simple, surtout quand on est pas un expert en API ou autre...

Du coup je poste ici ma version qui consiste en une controle TreeView qui liste tout les sous repertoire (et sous repertoire des sous repertoires) et fichiers d'un dossier donné, puis a partir de la, avec un control sur les checkboxes, on ajout les infos a une table:

/!\ Ne pas oublié d'activer les CheckBoxes du TreeView si vous voulez ajouter les données a une table/!\

La procédure sur le formulaire (Control TreeView nommée xTree):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Sub Form_Load()
    Dim nodCurrent As Node, objTree As TreeView
    Dim nodParent As Node, bk As String, Path
 
    MsgBox "Choosing a complexe folder / Drive may require a lot of time to be analyzed by Access", vbInformation + vbOKOnly, "Warning"
 
    Path = OpenedDirectory()
 
    If Path <> "" Then
        Set objTree = Forms!Explorer.xTree.Object
        Select Case Len(Path)
        Case 3
        Set nodParent = objTree.Nodes.Add(, , , Replace(Path, "\", ""))
        Case Else
        Set nodParent = objTree.Nodes.Add(, , , Path)
        End Select
        nodParent.Bold = True
        AddBranch Path, objTree, nodParent
 
    End If
End Sub

La procédure sur un module

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Public Sub AddBranch(ByVal way As String, Tree As TreeView, ByVal nodSup As Node)
    Dim fso, MainFolder, ListFolder, Folder, File, ListFile
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set MainFolder = fso.GetFolder(way)
    Set ListFolder = MainFolder.SubFolders
 
    For Each Folder In ListFolder
        On Error Resume Next
        Set nodCurrent = Tree.Nodes.Add(nodSup, tvwChild, , Folder.Name)
        nodCurrent.Bold = True
        AddBranch Folder, Tree, nodCurrent
    Next
 
    Set ListFile = MainFolder.Files
    For Each File In ListFile
        On Error Resume Next
        Tree.Nodes.Add nodSup, tvwChild, , File.Name
    Next
End Sub

La procédure pour ouvrir le dossier racine (toujours dans le module)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Public Function OpenedDirectory() As String
Dim objShell As Object, objFolder As Object, oFolderItem As Object
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Select the location of your files", &H1&)
On Error Resume Next
Set oFolderItem = objFolder.Items.Item
If Err <> 0 Then Exit Function
On Error GoTo 0
OpenedDirectory = oFolderItem.Path
End Function

La procédure inspiré du FAQ avec la requete SQL pour ajouter a la table:
A mettre dans le formulaire, avec un bouton nommé NomBouton

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Private Sub NomBouton_Click()
    Dim currentNode As MSComctlLib.Node 'parcours du node courrant
 
    'Pour chaque node contenu dans la collection nodes de ton objet treeview
    For Each currentNode In xTree.Nodes
        'Traitement du node courrant
        If currentNode.Checked Then
            DoCmd.RunSQL "INSERT INTO [T_Linked_docs] ([Name], [Link], [Proposal Reference]) VALUES ('" & currentNode.text & "','" & currentNode.FullPath & "','" & ref.Value & "')"
        End If
    Next
End Sub

Voila, il y a surement des optimisations possibles...et j'espère que ca pourra aider (jor j'aurai bien aimé faire en sorte que le treeview ne liste les repertoires inférieurs que lorsqu'on expand un noeud...) pour éviter d'avoir a tout charger la premiere fois...

Voila bonne lecture, et toujours dans l'attente de commentaire

--------Edit--------

J'ai répondu a mon idée ^^

suffit de mettre le code suivant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Private Sub xTree_NodeClick(ByVal sNode As Object)
    Dim objTree As TreeView
    Set objTree = Forms!Explorer.xTree.Object
 
    If sNode.Bold Then
        If sNode.Child Is Nothing Then
            AddBranch sNode.FullPath & "\", objTree, sNode
        End If
    End If
End Sub

et de faire les retouches dans le reste (enlever la recursivité dans la fonction AddBranch, et adapter les paramètres chargés lors de l'ouverture du Formulaire)

[alassanediakite]

Salut
Que pensez-vous de mon exemple?
@+

[iFitch]

Pas mal dommage que je ne l'ai pas vu avant :/ ca m'aurai bien aidé.

Juste c dommage de devoir double clicker sur un dossier pour le scanner plutot qu'un seul click...

et par contre c'est bien ca me rappel que j'ai oublié de reinitialiser les variables, et j'ai enfin eu une réponse pour comment gérer l'erreur 70 (permission denied) ^^

[iFitch]

Suite de mon code:

On enregistre les chemin des fichiers mais on aimerait aussi pouvoir recréer un arbre a partir de ces liens et si possible sans doublons:

On commence les hostilités avec un minifonction pour comparer la valeur du noeud avec celle du repertoire choisi:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Public Function ScanNodes(ByVal scPath As String, ByVal sNode As Node) As Boolean
    Dim sLength As Integer
 
    sLength = InStr(1, scPath, "\", vbTextCompare)
 
    If sLength = 0 Then Exit Function
 
        If sNode.text = Mid(scPath, 1, sLength - 1) Then
            ScanNodes = True
        Else
            ScanNodes = False
        End If
 
End Function

Puis on utilise la fonction suivante pour scanner les enfants d'un noeud

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Public Function ScanChild(sNode As MSComctlLib.Node, NbChild As Integer, ByVal sPath As String) As Node
    Dim xNode As Node
 
    If NbChild = 0 Then Exit Function
    Set xNode = sNode
 
    For i = 1 To NbChild
 
        If ScanNodes(sPath, xNode) Then
            Set ScanChild = xNode
            Exit Function
        End If
 
        If i < NbChild Then Set xNode = xNode.Next
 
    Next
 
    Set xNode = Nothing
 
End Function

et enfin la procédure pour créer l'arbre final:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
Sub ViewFiles(objTree As TreeView, SalesReference As String)
    Dim NodeSup, currentNode As Node
    Dim Length As Integer
    Dim xPath, Cut As String
    Dim rst As New ADODB.Recordset
    Dim Connect As New ADODB.Connection
 
    'Create a connection to generate the Recordset search
    Connect.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.FullName & ";"
    Connect.Open
 
    'Open the record set to get ad hoc results (Path of files based on SalesReference of the proposal
    rst.Open "SELECT Link, ProposalReference FROM T_Linked_Docs WHERE ProposalReference='" & SalesReference & "';", Connect
 
    'Create the first Branch of the treeview. This method enables to bypass replicates of drives
    objTree.Nodes.Clear
    Set currentNode = objTree.Nodes.Add(, , , "Proposal: " & SalesReference)
    currentNode.Bold = True
    currentNode.Selected = True
 
    'Scipt to populate the treeview
    While Not (rst.EOF)
        xPath = rst("Link").Value
        Length = InStr(1, xPath, "\", vbTextCompare)
 
        'Set a temporary variable
        Set NodeSup = currentNode
 
        'Scan every Children of this Node.
        'While common Child exists:
        '    -> set cursor on the common child node
        '    -> remove reference in path
        '    -> run scan again
 
        While Not ScanChild(NodeSup.Child, NodeSup.Children, xPath) Is Nothing
            Set NodeSup = ScanChild(NodeSup.Child, NodeSup.Children, xPath)
            Cut = Mid(xPath, 1, Length)
            xPath = Replace(xPath, Cut, "")
            Length = InStr(1, xPath, "\", vbTextCompare)
        Wend
 
        'Then add the new branch to TreeView
        '   -> While loop stands for eventual remaining new Folders
        While Length > 0
            Set NodeSup = objTree.Nodes.Add(NodeSup, tvwChild, , Mid(xPath, 1, Length - 1))
            NodeSup.Bold = True
            Cut = Mid(xPath, 1, Length)
            xPath = Replace(xPath, Cut, "")
            Length = InStr(1, xPath, "\", vbTextCompare)
        Wend
 
        '   -> Here we add the file, and move to next rexord
        objTree.Nodes.Add NodeSup, tvwChild, , xPath
        rst.MoveNext
 
    Wend
 
    objTree.SelectedItem.Expanded = True
 
    'Close Connection and Recordset
    rst.Close
    Connect.Close
    Set NodeSup = Nothing
    Set currentNode = Nothing
 
End Sub

Voili voilou il suffit plus qu'a appeller la procedure dans le formulaire qui contient le control treeview de la facon suivante:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
    Dim sTree As TreeView
    Set sTree = Me.xTree.Object
 
    ViewFiles sTree, SaleReference
    Set sTree = Nothing

xTree etant le nom du controle
T_Linked_Docs la table ou sont stockés les liens recupérés par la procédure utilisée dans mon premier message.
SaleReference est le critére sur lequel repose ma requete SQL
(les fichiers sont ajoutés dans un table avec un champ pour retenir la SaleReference a laquelle on ajoute les fichiers, donc ce critere permet de ne recupérer que les fichiers concernés)

J'espère que ca pourra servir parce que j'ai bien galérer a tout mettre en place (debutant inside :/)