Discussion :

[shub]

Bonjour,
Je souhaiterai via la boite de dialogue recuperer les chemins de plusieurs fichiers pour ensuite integrer cette liste de fichiers dans ne liste d'un formulaire access Malheuresement je ne recupere qu'un string avec tout les nom des fichiers et seul le premier est écrit en entier avec son chemin. J'aimerai bien connaitre la solution pour avoir le chemin de tout les fichiers et de pouvoir les dissocier afin de créer une liste.
Merci

[Dolphy35]

Salut,

Tous es dans la FAQ.

Voici un code récupérer dans la FAQ et aménagé pour ton utilisation

Copie ce code dans 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
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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
'---------------------------------------------------------------------------------------
 ' Permet d'ouvrir la Boîte de Dialogue 'Ouvrir' en multi Select ou Non
 '---------------------------------------------------------------------------------------
Option Compare Database
Option Explicit
 
Public Type OpenFileName
 
lStructSize As Long
hwndOwner As Long
Instance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustomFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
 
End Type
 
Public Declare Function GetOpenFileName Lib "comdlg32.dll" _
    Alias "GetOpenFileNameA" (pOpenfilename As OpenFileName) As Long
 
Public Const OFN_AllowMultiSelect = &H200
Public Const OFN_CreatePrompt = &H2000
Public Const OFN_EnableHook = &H20
Public Const OFN_EnableTemplate = &H40
Public Const OFN_EnableTemplateHandle = &H80
Public Const OFN_EXPLORER = &H80000
Public Const OFN_ExtensionDifferent = &H400
Public Const OFN_FileMustExist = &H1000
Public Const OFN_HideReadOnly = &H4
Public Const OFN_LongNames = &H200000
Public Const OFN_NoChangeDir = &H8
Public Const OFN_NoDeReferenceLinks = &H100000
Public Const OFN_NoLongNames = &H40000
Public Const OFN_NoNetWorkButton = &H20000
Public Const OFN_NoReadOnlyReturn = &H8000
Public Const OFN_NoTestFileCreate = &H10000
Public Const OFN_NoValiDate = &H100
Public Const OFN_OverWritePrompt = &H2
Public Const OFN_PathMustExist = &H800
Public Const OFN_ReadOnly = &H1
Public Const OFN_ShareAware = &H4000
Public Const OFN_ShareFallThrough = 2
Public Const OFN_ShareNoWarn = 1
Public Const OFN_ShareWarn = 0
Public Const OFN_ShowHelp = &H10
 
 
Global Dialogue As OpenFileName
 
Public strFiltre As String
Public strFile As String
Public strNomFile As String
Public RetVal As Long
 
Public Function OpenFile(Optional strTitle As Variant, _
                         Optional strInitialDir As Variant, _
                         Optional MultiSelect As Boolean = True) As String
 
If IsMissing(strTitle) Then
strTitle = "Ouvrir..."
End If
 
If IsMissing(strInitialDir) Then
    strInitialDir = CurDir
End If
 
OpenFile = ""
strFiltre = "Tous" & Chr$(0) & "*.*"
 
With Dialogue
    .lStructSize = Len(Dialogue)
    .lpstrFilter = strFiltre
    .lpstrFile = Space(254)
    .nMaxFile = 255
    .lpstrFileTitle = Space(254)
    .nMaxFileTitle = 255
    .lpstrInitialDir = strInitialDir
    .lpstrTitle = strTitle
  If MultiSelect = False Then
    .flags = OFN_FileMustExist + _
             OFN_HideReadOnly + _
             OFN_PathMustExist
  Else
    .flags = OFN_FileMustExist + _
             OFN_HideReadOnly + _
             OFN_PathMustExist + _
             OFN_AllowMultiSelect + _
             OFN_LongNames + _
             OFN_EXPLORER
  End If
End With
 
RetVal = GetOpenFileName(Dialogue)
 
If RetVal >= 1 Then
    OpenFile = fMultiSelect(Dialogue.lpstrFile)
Else
    OpenFile = ""
    Exit Function
End If
 
End Function
 
Function fMultiSelect(ByVal strItem As String) As String
 
Dim TabFile As Variant
Dim i As Integer
 
TabFile = fSplit(strItem, vbNullChar)
 
 If UBound(TabFile) = 1 Then
    fMultiSelect = TabFile(0)
 Else
    For i = 1 To (UBound(TabFile) - 1)
        If fMultiSelect = "" Then
            fMultiSelect = TabFile(0) & "\" & TabFile(i)
        Else
            fMultiSelect = fMultiSelect & ";" _
                           & TabFile(0) & "\" & TabFile(i)
        End If
    Next i
 End If
 
End Function
 
Function fSplit(ByVal sIn As String, _
            Optional sDelim As String, _
            Optional nLimit As Long = -1, _
            Optional bCompare As Long = vbBinaryCompare) _
            As Variant
 
 Dim sRead As String
 Dim sOut() As String
 Dim nC As Integer
 
  If sDelim = "" Then
     fSplit = sIn
  End If
 
 sRead = fReadUntil(sIn, sDelim, bCompare)
 
 Do
    ReDim Preserve sOut(nC)
    sOut(nC) = sRead
    nC = nC + 1
    If nLimit <> -1 And nC >= nLimit Then
        Exit Do
    End If
    sRead = fReadUntil(sIn, sDelim)
 Loop While sRead <> ""
ReDim Preserve sOut(nC)
sOut(nC) = sIn
fSplit = sOut
End Function
 
Function fReadUntil(ByRef sIn As String, _
                sDelim As String, _
                Optional bCompare As Long = vbBinaryCompare) _
                As String
 
Dim nPos As String
nPos = InStr(1, sIn, sDelim, bCompare)
 
If nPos > 0 Then
    fReadUntil = Left(sIn, nPos - 1)
    sIn = Mid(sIn, nPos + Len(sDelim))
End If
End Function

En suite tu appel la fonction comme ceci

Code :

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

MsgBox OpenFile(True, "Test", "D:")

True => Sélection Multiple
OpenFile => Fonction
C: => Répertoire

Le premier argument est obligatoire les autres sont facultatifs.

[shub]

Merci j'avais vu ce code mais je ne l'avais pas compris.
par contre sur le

RetVal = GetOpenFileName(Dialogue)

il me met element ByRef incompatible;je n ecomprend pas.

[shub]

De plus j'ai l'impression qu'il ne rentre pas dans la partie traitement, ou qu'en tout cas elle n efonctionne pas car je n'ai toujours qu'une seule chaine de caractère..Je ne sais pas comment faire pour traiter cette chaine..