Problème avec certains fichiers - BrowseForFolder

Version imprimable

Bonjour,

J'utilise la propriété BrowseForFolder pour choisir des répertoires ou des fichiers en VBScript.
Je récupère bien le chemin des objets sélectionnés, mais le problème se pose avec certains type de fichiers (*.vbs, *.ini, *.txt, *.doc, etc.)
Par exemple je peux sélectionner et récupérer le chemin d'un fichier docx mais pas doc.

Voici le code utilisé :

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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
 
Sub addFile()
	On Error Resume Next
 
	Const BIF_returnonlyfsdirs   = &H0001
	Const BIF_browseincludefiles = &H4000
 
	Dim objectFile, selectedItem
 
	objectFile = BrowseForFolder( _
			"Select a file or folder to copy", _
			BIF_returnonlyfsdirs + BIF_browseincludefiles, _
			"C:\Users\Toto\Documents")
	If objectFile = "-5" Then 
		MsgBox "Vous ne pouvez pas choisir le répertoire racine", vbCritical, "Répertoire racine"
	Else
		If objectFile = "-1" Then 
			MsgBox "Vous ne pouvez pas choisir le répertoire racine", vbCritical, "Répertoire racine"
		ElseIf objectFile = "2" then
			'MsgBox "Aucun objet sélectionné !", vbInformation, "Info !"
			Location.Reload(True)
		Else
			'MsgBox "Object: " & objectFile
			Set selectedItem = WshFso.GetFile(objectFile)
			If Err.Number = 53 Then
				MsgBox "Vous ne pouvez pas inclure de répertoire", vbCritical, "Répertoire"
			Else
				inclFileList2.WriteLine objectFile
				Location.Reload(True)
			End If
		End If
	End If
End Sub
 
Function BrowseForFolder(title, flag, dir)
	On Error Resume Next
 
	Dim oItem, tmp
 
	'Boîte de dialogue
	Set oItem = oShell.BrowseForFolder(&H0, title, flag, dir)
	If Err.Number <> 0 Then
		If Err.Number = 5 Then
			BrowseForFolder= "-5"
			Err.Clear
			Set oItem = Nothing
			Exit Function
		End If
	End If
 
	'Récupération du chemin
	If oItem = "" Then
		MsgBox "Annulation / Fichier ou répertoire invalide", vbCritical, "Attention !"
		BrowseForFolder = "2"
	Else
		BrowseForFolder = oItem.ParentFolder.ParseName(oItem.Title).Path
	End If
 
	'Gestion annulation
	If Err <> 0 Then
		If Err.Number = 424 Then           'Annulation
			BrowseForFolder = "-1"
		Else
			Err.Clear
				'Si sélection d\'un lecteur - gestion du ":"
			tmp = InStr(1, oItem.Title, ":")
			If tmp > 0 Then
				BrowseForFolder = _   
					Mid(oItem.Title, (tmp - 1), 2) & "\"
			End If
		End If
	End If
 
	Set oItem = Nothing
	On Error GoTo 0
End Function

Merci d'avance pour votre aide :D.

Srini

11/05/2011, 11h10
ced600

Citation:

Je récupère bien le chemin des objets sélectionnés, mais le problème se pose avec certains type de fichiers (*.vbs, *.ini, *.txt, *.doc, etc.)
Par exemple je peux sélectionner et récupérer le chemin d'un fichier docx mais pas doc.

Je n'ai pas compris. Lorsque tu sélectionne un fichier doc, BrowseForFolder te renvois un path incorrecte ? Dans ce cas donne nous le code de la fonction ParseName.
Sinon c'est quoi le pb ?

Bonjour,

Merci pour ta réponse.

On va partir sur un code simple utilisant BrowseForFolder :
Code:

1 2 3 4 5 6 7 8 9 set oShell = CreateObject("Shell.Application") Set oFolder = oShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H0001 + &H4000,"c:\users\tutu\documents") If oFolder is Nothing Then MsgBox "Abandon opérateur",vbCritical Else Set oFolderItem = oFolder.Self MsgBox oFolderItem.path End If
Si la tu essaye de sélectionner un doc, un vbs, ou ini par exemple il me sort l'erreur suivant : "Erreur non spécifiée. Code 80004005" à la ligne 3.

Si je sélectionne un autre type de fichier (docx, pdf, ...) ou bien un dossier ça marche :s

Merci.

Function BrowseForFile

:salut:
Voila essayez avec ce script trouvé sur le Net peut-être ça va marcher pour vous ;)

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
Function BrowseForFile()
	Dim shell : Set shell = CreateObject("WScript.Shell")
	Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
	Dim tempFolder : Set tempFolder = fso.GetSpecialFolder(2)
	Dim tempName : tempName = fso.GetTempName()
	Dim tempFile : Set tempFile = tempFolder.CreateTextFile(tempName & ".hta")
	tempFile.Write _
	"<html>" & _
	"    <head>" & _
	"        <title>Browse</title>" & _
	"    </head>" & _
	"    <body>" & _
	"        <input type='file' id='f'>" & _
	"        <script type='text/javascript'>" & _
	"            var f = document.getElementById('f');" & _
	"            f.click();" & _
	"            var shell = new ActiveXObject('WScript.Shell');" & _
	"            shell.RegWrite('HKEY_CURRENT_USER\\Volatile Environment\\MsgResp', f.value);" & _
	"            window.close();" & _
	"        </script>" & _
	"    </body>" & _
	"</html>"
	tempFile.Close
        shell.Run tempFolder & "\" & tempName & ".hta", 1, True
        BrowseForFile = shell.RegRead("HKEY_CURRENT_USER\Volatile Environment\MsgResp")
	shell.RegDelete "HKEY_CURRENT_USER\Volatile Environment\MsgResp"
End Function
 
MsgBox BrowseForFile,64,"BrowseForFile"

11/05/2011, 14h06
Sprsrini

Salut,

Merci pour ta solution.

Toutefois, je dois pouvoir choisir les fichiers et les dossiers, ce que le

Code:

<input type='file' id='f'>

ne permet pas.
11/05/2011, 15h04
ced600

Autant pour moi j'ai mal lu la ligne de code, parsename est une méthode de BrowseForFolder.
Je n'ai pas la solution.
11/05/2011, 17h39
Sprsrini

Autre point que j'ai oublié de préciser : je dois pouvoir browser des fichiers et des dossiers sous XP et 7.

Merci
11/05/2011, 17h47
ced600

Au vu des classes utilisés, je pense que les codes présentés sont compatibles sur les deux OS.
Mais de toutes manières tu peux taper le nom de la classe, la méthode et MSDN sur google. Là tu auras dans les premiers liens la page MSDN décrivant la méthode et sur cette page il sera également écrit sur quel version de l'OS la méthode est disponible.