Boite de dialogue, sélection type de fichier

Version imprimable

Bonjour,
J'ai repris une fonction d'omen999 :
En modifiant le sFilter, mais je ne peux commencer par filtrer les ofx, je suis toujours obligé de passer par tous les fichiers, ensuite la fonction permet le filtre.
Ce que je souhaite c'est arriver dans la boite de dialogue avec les fichiers filtrés.
Merci d'avance pour votre aide :P

Code:

1
2
3
4
5
6
7
8
9
10
11
sIniDir = "D:\Downloads\*" 
sFilter = "ofx Files (*.ofx)|*.ofx|All files (*.*)|*.*|Microsoft Word (*.doc;*.docx)|*.doc;*.docx|" 
sTitle = "GetFileDlg by omen999 2014 - http://omen999.developpez.com" 
rep = GetFileDlgEx(Replace(sIniDir,"\","\\"),sFilter,sTitle) 
MsgBox rep & vbcrlf & Len(rep)
 
Function GetFileDlgEx(sIniDir,sFilter,sTitle) '"no limit" Browse dialog : the global size of the parameters isn't limited anymore
    Set oDlg = CreateObject("WScript.Shell").Exec("mshta.exe ""about:<object id=d classid=clsid:3050f4e1-98b5-11cf-bb82-00aa00bdce0b></object><script>moveTo(0,-9999);eval(new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(0).Read("&Len(sIniDir)+Len(sFilter)+Len(sTitle)+41&"));function window.onload(){var p=/[^\0]*/;new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(p.exec(d.object.openfiledlg(iniDir,null,filter,title)));close();}</script><hta:application showintaskbar=no />""")
    oDlg.StdIn.Write "var iniDir='" & sIniDir & "';var filter='" & sFilter & "';var title='" & sTitle & "';"
    GetFileDlgEx = oDlg.StdOut.ReadAll
End Function

04/06/2015, 19h20
l_autodidacte

Voici avec VBscript Comment ouvrir la boite de sélection de fichiers
05/06/2015, 09h42
Superpat9999
Citation:

Envoyé par l_autodidacte

Voici avec VBscript Comment ouvrir la boite de sélection de fichiers

Merci de votre réponse, mais j'avais déjà lu la page.
Curieusement avec le code ci-dessous cela fonctionne, mais je ne peux rien mettre dans SInidir.
Dans ce cas là, je souhaite savoir où se trouve par défaut le dossier d'ouverture. :roll:
Code:

1 2 3 SIniDir = "" SFilter = "ofx Files (*.ofx)|*.ofx|All files (*.*)|*.*|Microsoft Word (*.doc;*.docx)|*.doc;*.docx|Adobe pdf (*.pdf)|*.pdf|" STitle = "Selectionner le fichier ofx"

Il y a un code que j'ai posté ICI dont un extrait est utilisé dans le code plus bas.
Mais ce code-ci va contraindre l'utilisateur à afficher 2 boites de dialogue et choisir un dossier puis un fichier :

Code:

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
Option Explicit
Call BrowseForFile
Private Sub BrowseForFile()
    Dim oDlg, sInitDIr
    Set oDlg = CreateObject("UserAccounts.CommonDialog")
    oDlg.Filter = "Tout fichier(*.*)|*.*|Fichier texte(*.txt)|*.txt|Visual basic form(*.frm)|*.frm" & _
    "|Documents Word(*.doc;*.docx)|*.doc;*.docx|Bibliothèque(*.dll)|*.dll"
    sInitDir = SelectFolder
    oDlg.InitialDir = sInitDir
    oDlg.FilterIndex = 4 ' correspond à Documents Word, filtre par défaut
    oDlg.ShowOpen
    If oDlg.FileName = "" Then Exit Sub
    MsgBox oDlg.FileName
End Sub
'======================
Function SelectFolder()
    Const BIF_returnonlyfsdirs = &H1 ' On peut mettre &H4000 pour retourner les fichiers et/ou dossiers
                 'mais une erreur se produit si on sélectionne un fichier
    Dim WSH, Item, lngFlag, Result, InitDir, DialogTitle, drv, fso, WS
 
    Set WSH = CreateObject("Shell.Application")
    lngFlag = BIF_returnonlyfsdirs
    'InitDir = "C:"
    DialogTitle = "Sélection de dossier : Pas de  Poste de travail, Favoris réseau et/ou ses sous-éléments:"
    Set Item = WSH.BrowseForFolder(0, DialogTitle, lngFlag, "")
    If Item Is Nothing Then WScript.Quit 0
    Set WS = CreateObject("WScript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    If LCase(Item.Title) = "poste de travail" Or LCase(Item.Title) = "favoris réseau" Then
         MsgBox "Mauvais choix de répertoire [" & UCase(Item.Title) & "]" & vbCrLf & _
                 "Choisir un répertoire valide puis réessayer."
         WScript.Quit 0
    End If
    If LCase(Item.Title) = "mes documents" Or LCase(Item.Title) = "bureau" Then
         Result = WS.ExpandEnvironmentStrings("%UserProfile%") & "\" & Item.Title
    ElseIf Is_Value(Item) Then
       Result = Item.Title
        If Right(Result, 2) = ":)" Then
            Set drv = fso.GetDrive(Left(Right(Result, 3), 2))
            Result = drv.RootFolder
        ElseIf InStr(1, Result, ":") = 0 Then
            Result = Item.ParentFolder.ParseName(Item.Title).Path
        End If
    End If
   SelectFolder = Result
End Function
'================================
Function Is_Value(obj)
   Dim stmp
    On Error Resume Next
    stmp = " " & obj
    Is_Value = (Err = 0)
    On Error GoTo 0
End Function

Faute de grives, on mange les merles !!

08/06/2015, 11h20
omen999

bonjour,
c'est vrai que je n'ai pas donné beaucoup de détails sur la syntaxe à respecter
pour utiliser ce code :aie:

en réalité, le paramètre sIniDir définit à la fois le répertoire d'ouverture ET
le 1er item actif du filtre (d'où la nécessité de placer cet item en tête de liste dans sFilter)
c'est la raison pour laquelle mon exemple définit un sIniDir se terminant par un astérisque
puisque le 1er item de sFilter est "All Files"

il y a toutefois, une petite subtilité de syntaxe :mrgreen:
pour être reconnue, l'extension doit aussi être précédée d'un astérisque...

dans ton cas, ceci devrait faire l'affaire :

Code:

sIniDir = "D:\Downloads\*.*ofx"
08/06/2015, 12h09
Superpat9999

Boite de dialogue, sélection type de fichier

Merci à l_autodidacte et à omen999,
J'ai bien le résultat désiré. :D
Bonne journée 8-)