Référence pour CommonDialog

Const RETURNONLYFSDIRS = &H1 
BIF_returnonlyfsdirs   = &H0001
BIF_dontgobelowdomain  = &H0002
BIF_editbox            = &H0010
BIF_validate           = &H0020
BIF_browseforcomputer  = &H1000
Dim  MyInputbox
Dim  Chemin
Dim  oFolder, oShell

Set oShell = CreateObject("Shell.Application") 
Set oFolder = oShell.BrowseForFolder(&H0&, "Choisir un répertoire", RETURNONLYFSDIRS, "c:\") 

If oFolder is Nothing Then  
	MsgBox "Abandon opérateur",vbCritical 
Else 
  Set oFolderItem = oFolder.Self 
 Chemin=oFolderItem.path 
Chemin=InputBox("Copiez pour mettre le chemin dans le presse-papier", "Chercher chemin dossier", Chemin)
End If 

Const RETURNONLYFSDIRS = &H1 
BIF_returnonlyfsdirs   = &H0001
BIF_dontgobelowdomain  = &H0002
BIF_editbox            = &H0010
BIF_validate           = &H0020
BIF_browseforcomputer  = &H1000
Dim Titre, Choix, vbCrlf, Tache, ChoixMsg 
Dim MyVar, MyInputbox
Dim Chemin
Dim WshShell, objDlg, oFolder, oShell
Dim shell, item
Set shell = WScript.CreateObject("Shell.Application")
flag=BIF_returnonlyfsdirs
Set WshShell = wscript.CreateObject("WScript.Shell")

Titre = "Rechercher fichier et dossier"
vbCrlf = Chr(13)
Tache = Split("Rechercher fichier,Rechercher dossier,Quitter,",",")
   
Do
      Choix = Inputbox("Entrez le numéro de la tâche que vous désirez effectuer :" & vbCrlf & vbCrlf & "1) Rechercher fichier" & vbCrlf & "2) Rechercher dossier" & vbCrlf &  "0) Quitter", Titre, "0")

If Choix <> 0 Then
       On Error Resume Next
        Select Case Choix
                
                Case 1: 
sIniDir = "C:\Windows\*" 
sFilter = "All files (*.*)|*.*|Microsoft Word (*.doc;*.docx)|*.doc;*.docx|Adobe pdf (*.pdf)|*.pdf|Image files (*.gif;*.png;*jpg;*.bmp)|*.gif;*.png;*jpg;*.bmp|Html files (*.htm;*.html;*.mht)|*.htm;*.html;*.mht|" 
sTitle = "Rechercher chemin fichier"
rep = GetFileDlgEx(Replace(sIniDir,"\","\\"),sFilter,sTitle) 
Chemin=rep & vbcrlf & Len(rep)
Chemin=InputBox("Copiez pour mettre le chemin dans le presse-papier", "Rechercher chemin fichier", Chemin) 
               
 Case 2 :
Set oShell = CreateObject("Shell.Application") 
Set oFolder = oShell.BrowseForFolder(&H0&, "Choisir un répertoire", RETURNONLYFSDIRS, "c:\") 

If oFolder is Nothing Then  
	MsgBox "Abandon opérateur",vbCritical 
Else 
  Set oFolderItem = oFolder.Self 
 Chemin=oFolderItem.path 
Chemin=InputBox("Copiez pour mettre le chemin dans le presse-papier", "Rechercher chemin dossier", Chemin)
End If 
  
 End Select
       
On Error Goto 0
End If

If Choix = 0 Then
	ChoixMsg = MsgBox("Souhaitez-vous quittez l'application ?", vbYesNoCancel, Titre)
		If ChoixMsg = vbYes Then WScript.quit
	End If
Loop

Function GetFileDlgEx(sIniDir,sFilter,sTitle) 
  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