| | auteur : shwin | Cette fonction propose plusieurs arguments utiles pour personnaliser votre boîte de dialogue, ils sont expliqués dans le code.
Code à placer dans un module :
Private Declare Sub PathStripPath Lib "shlwapi.dll" Alias "PathStripPathA" (ByVal pszPath As String)
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter 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
Private Const OFN_READONLY = &H1
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_SHOWHELP = &H10
Private Const OFN_ENABLEHOOK = &H20
Private Const OFN_ENABLETEMPLATE = &H40
Private Const OFN_ENABLETEMPLATEHANDLE = &H80
Private Const OFN_NOVALIDATE = &H100
Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_EXTENSIONDIFFERENT = &H400
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_CREATEPROMPT = &H2000
Private Const OFN_SHAREAWARE = &H4000
Private Const OFN_NOREADONLYRETURN = &H8000
Private Const OFN_NOTESTFILECREATE = &H10000
Private Const OFN_SHAREFALLTHROUGH = 2
Private Const OFN_SHARENOWARN = 1
Private Const OFN_SHAREWARN = 0
Public Function OuvrirUnFichier(Handle As Long, _
Titre As String, _
TypeRetour As Byte, _
Optional TitreFiltre As String, _
Optional TypeFichier As String, _
Optional RepParDefaut As String) As String
Dim StructFile As OPENFILENAME
Dim sFiltre As String
If Len(TitreFiltre) > 0 And Len(TypeFichier) > 0 Then
sFiltre = TitreFiltre & " (" & TypeFichier & ")" & Chr$(0) & "*." & TypeFichier & Chr$(0)
End If
sFiltre = sFiltre & "Tous (*.*)" & Chr$(0) & "*.*" & Chr$(0)
With StructFile
.lStructSize = Len(StructFile)
.hwndOwner = Handle
.lpstrFilter = sFiltre
.lpstrFile = String$(254, vbNullChar)
.nMaxFile = 254
.lpstrFileTitle = String$(254, vbNullChar)
.nMaxFileTitle = 254
.lpstrTitle = Titre
.flags = OFN_HIDEREADONLY
If ((IsNull(RepParDefaut)) Or (RepParDefaut = "")) Then
RepParDefaut = CurrentDb.Name
PathStripPath (RepParDefaut)
.lpstrInitialDir = Left(CurrentDb.Name, Len(CurrentDb.Name) - Len(Mid$(RepParDefaut, 1, _
InStr(1, RepParDefaut, vbNullChar) - 1)))
Else: .lpstrInitialDir = RepParDefaut
End If
End With
If (GetOpenFileName(StructFile)) Then
Select Case TypeRetour
Case 1: OuvrirUnFichier = Trim$(Left(StructFile.lpstrFile, InStr(1, StructFile.lpstrFile, vbNullChar)-1))
Case 2: OuvrirUnFichier = Trim$(Left(StructFile.lpstrFileTitle, InStr(1, StructFile.lpstrFileTitle, vbNullChar)-1))
End Select
End If
End Function
|
Exemple pour appeler la fonction depuis le code d'un formulaire :
MsgBox OuvrirUnFichier(Me.Hwnd, "Parcourir", 1, "Fichier Word", "doc")
|
|
lien : Afficher la boîte de dialogue Enregistrer sous afin de récupérer le nom et le chemin du fichier sélectionné
lien : Utilise le contrôle Common Dialog pour récupérer le chemin d'un fichier
lien :  Comment avec l'API GetOpenFileNameA ouvrir plusieurs fichiers à la fois ?
|
| | auteur : shwin | Note : Les arguments de cette fonction sont expliqués dans le code.
Code à placer dans un module :
Private Declare Function GetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) _
As Long
Private Type OPENFILENAME
lStructSize As Long
hWndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter 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
Function EnregistrerUnFichier(Handle As Long, Titre As String, _
NomFichier As String, Chemin As String) As String
la boîte de dialogue d
Dim structSave As OPENFILENAME
With structSave
.lStructSize = Len(structSave)
.hWndOwner = Handle
.nMaxFile = 255
.lpstrFile = NomFichier & String$(255 - Len(NomFichier), 0)
.lpstrInitialDir = Chemin
.lpstrFilter = "Tous (*.*)" & Chr$(0) & "*.*" & Chr$(0)
.Flags = &H4
End With
If (GetSaveFileName(structSave)) Then
EnregistrerUnFichier = Mid$(structSave.lpstrFile, 1, InStr(1, structSave.lpstrFile, vbNullChar) - 1)
End If
End Function
|
Exemple pour appeler la fonction depuis le code d'un formulaire :
MsgBox EnregistrerUnFichier(Me.hwnd, "Enrégistrer sous", "Test.doc", "C:\")
|
|
lien : Afficher la boîte de dialogue ouvrir afin de récupérer le nom et le chemin du fichier sélectionné
lien : Utilise le contrôle Common Dialog pour récupérer le chemin d'un fichier
|
| | auteur : Team Access | Cette fonction reçoit le chemin complet d'un fichier en paramètre et renvoie le chemin du répertoire : Public Function ExtractFolder(ByVal sFullPath As String) As String
If Right(sFullPath, 1) = "\" Then
ExtractFolder = sFullPath
Else
ExtractFolder = Left(sFullPath, InStrRev(sFullPath, "\"))
End If
End Function
|
|
lien : FAQ VB
|
| | auteur : Romain Puyfoulhoux | Dim rep As String
rep = Dir("c:\*.*", vbDirectory)
Do While (rep <> "")
If (GetAttr("c:\" & rep) And vbDirectory) = vbDirectory Then
MsgBox "Répertoire " & rep
Else
MsgBox "Fichier " & rep
End If
rep = Dir
Loop
|
|
lien : FAQ VB
|
| | auteur : Romain Puyfoulhoux | Pour récupérer les chemins complets des répertoires du Bureau, de Mes Documents, ou du menu Démarrer, vous pouvez utiliser la fonction SHGetSpecialFolderPath de l'Api Windows : Private Declare Function SHGetSpecialFolderPath Lib "shell32.dll" Alias "SHGetSpecialFolderPathA" _
(ByVal hwndOwner As Long, ByVal lpszPath As String, _
ByVal nFolder As Long, ByVal fCreate As Long) As Long
|
Description des paramètres :
hwndOwner : handle de la fenêtre à utiliser si une boîte de dialogue doit être affichée
lpszPath : chaîne de caractères recevant le chemin complet du répertoire demandé
nFolder : nombre indiquant le répertoire demandé
fCreate : si la valeur passée à ce paramètre n'est pas nulle, le répertoire est créé, s'il n'existe pas déjà
Sous Windows NT 4.0 et Windows 95, cette fonction n'est disponible que si Internet Explorer 4.0 ou supérieur est installé. Voyons comment l'utiliser : Public Function GetSpecialFolderPath(dossier As Long, hwnd As Long)
Dim buffer As String
buffer = Space(256)
SHGetSpecialFolderPath hwnd, buffer, dossier, 0
GetSpecialFolderPath = Left(buffer, InStr(buffer, Chr(0)) - 1)
End Function
|
Pour tester cette fonction, placez par exemple ces 3 lignes dans une procédure du module d'une form : MsgBox GetSpecialFolderPath(0, Me.hwnd)
MsgBox GetSpecialFolderPath(5, Me.hwnd)
MsgBox GetSpecialFolderPath(11, Me.hwnd)
|
Les réfractaires aux Api Windows préfèreront utiliser le Windows Script Host Object Model en ajoutant wshom.ocx aux références du projet. Les chemins complets des répertoires spéciaux sont dans la collection SpecialFolders de l'objet WshShell. Dim Wsh As WshShell
Set Wsh = New WshShell
MsgBox Wsh.SpecialFolders.Item("Desktop")
MsgBox Wsh.SpecialFolders.Item("MyDocuments")
MsgBox Wsh.SpecialFolders.Item("StartMenu")
Set WshShell = nothing
End Sub
|
Avec les anciennes versions de Wshom.ocx, la classe WshShell s'appelle IWshShell_Class.
|
lien : FAQ VB
lien : Comment ouvrir un fichier HTML, Word, PDF ou autre en utilisant l'exécutable associé ?
lien : Que faire quand l'API ShellExecute ne fonctionne pas ?
|
| | auteur : Team Access |
La référence "Windows Script Host Object Model" (wshom.ocx) propose un objet permettant d'accéder aux répertoires spéciaux d'un ordinateur.
WshShell.SpecialFolders(repertoire)
|
Où repertoire, est une chaine de caractères définissant quel répertoire atteindre.
Liste des types de répertoires :
- AllUsersDesktop : D:\Documents and Settings\All Users\Bureau
- AllUsersStartMenu : D:\Documents and Settings\All Users\Menu Démarrer
- AllUsersPrograms : D:\Documents and Settings\All Users\Menu Démarrer\Programmes
- AllUsersStartup : D:\Documents and Settings\All Users\Menu Démarrer\Programmes\Démarrage
- Desktop : D:\Documents and Settings\Christophe\Bureau
- AppData : D:\Documents and Settings\Christophe\Application Data
- PrintHood : D:\Documents and Settings\Christophe\Voisinage d'impression
- Templates : D:\Documents and Settings\Christophe\Modèles
- Fonts : D:\WINDOWS\Fonts
- NetHood : D:\Documents and Settings\Christophe\Voisinage réseau
- StartMenu : D:\Documents and Settings\Christophe\Menu Démarrer
- SendTo : D:\Documents and Settings\Christophe\SendTo
- Recent : D:\Documents and Settings\Christophe\Recent
- Startup : D:\Documents and Settings\Christophe\Menu Démarrer\Programmes\Démarrage
- Favorites : D:\Documents and Settings\Christophe\Favoris
- MyDocuments : E:\
- Programs : D:\Documents and Settings\Christophe\Menu Démarrer\Programmes
Exemple :
Dim oWsh As New WshShell
MsgBox oWsh.SpecialFolders("Desktop")
|
|
lien : Comment créer un raccourci ?
lien : Comment déclarer une référence dans MS-Access ?
|
| | auteur : Romain Puyfoulhoux | Voici deux solutions possibles. Tout d'abord, les fonctions de l'API Windows : Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" _
(ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" _
(ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
|
Ces 3 fonctions de l'API Win32 renvoient respectivement les chemins complets des répertoires Windows, System, et Windows\Temp. Elles s'utilisent toutes les 3 de la même manière : Function GetWindowsDir() As String
Dim buffer As String * 256
Dim Length As Long
Length = GetWindowsDirectory(buffer, Len(buffer))
GetWindowsDir = Left(buffer, Length)
End Function
Function GetSystemDir() As String
Dim buffer As String * 256
Dim Length As Long
Length = GetSystemDirectory(buffer, Len(buffer))
GetSystemDir = Left(buffer, Length)
End Function
Function GetTempDir() As String
Dim buffer As String * 256
Dim Length As Long
Length = GetTempPath(Len(buffer), buffer)
GetTempDir = Left(buffer, Length)
End Function
|
Une autre manière de procèder est de faire appel au FileSystemObject : Dim fso As FileSystemObject
Set fso = New FileSystemObject
MsgBox fso.GetSpecialFolder(0)
MsgBox fso.GetSpecialFolder(1)
MsgBox fso.GetSpecialFolder(2)
Set fso = Nothing
End Sub
|
|
lien : FAQ VB
|
| | auteurs : Romain Puyfoulhoux, Arkham46 | Pour cela vous devez ajouter ces déclarations au début de votre module : Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, _
ByVal lpString2 As String) As Long
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
|
La fonction suivante ouvre la fenêtre de sélection de répertoire standard de Windows et renvoie le chemin du répertoire
sélectionné. Les paramètres attendus sont le titre à afficher et l'identifiant de la fenêtre parente. Public Function SelectFolder(Titre As String, Handle As Long) As String
Dim lpIDList As Long
Dim strBuffer As String
Dim strTitre As String
Dim tBrowseInfo As BrowseInfo
strTitre = Titre
With tBrowseInfo
.hWndOwner = Handle
.lpszTitle = lstrcat(strTitre, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
strBuffer = String(260, vbNullChar)
SHGetPathFromIDList lpIDList, strBuffer
SelectFolder = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
End If
End Function
|
Cette ligne fait appel à la fonction écrite ci-dessus pour ouvrir la fenêtre de sélection de répertoire et afficher
le répertoire sélectionné : MsgBox SelectFolder("Sélectionnez un répertoire :", Me.hWnd)
|
Il est posssible d'ajouter dans la boîte de dialogue un bouton permettant la création
d'un nouveau dossier.
il faut ajouter cette constante :
Private Const BIF_NEWDIALOGSTYLE As Long = &H40
|
Ensuite remplacer la ligne correspondante par ce code :
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_NEWDIALOGSTYLE
|
|
lien : FAQ VB
|
| | auteur : Frank | On envoie en entrée de cette fonction le nom complet d'un fichier et la fonction renvoie le répertoire dans lequel se trouve le fichier. Function ParentDir(ByVal str As String) As String
Dim i as Integer
If Right(str, 1) = "\" Then str = Left(str, Len(str) - 1)
For i = Len(str) To 1 Step -1
If Mid(str, i, 1) = "\" Then
Debug.Print "Fichier " & Right(str, Len(str) - i)
str = Left(str, i)
GoTo fin01
End If
Next i
fin01:
Debug.Print "Répertoire " & str
ParentDir = str
End Function
|
Solution possible depuis MS-Access 2000 : Function Path(ByVal sFullPath As String) As String
If Right(sFullPath,1)="\" then
Path=sFullPath
Else
Path=Left(sFullPath, InStrRev(sFullPath,"\"))
End If
End Function
|
|
Consultez les autres F.A.Q's
Les sources présentés sur cette pages sont libre de droits,
et vous pouvez les utiliser à votre convenance. Par contre cette page de présentation de ces sources constitue une oeuvre intellectuelle protégée par les droits d'auteurs.
Copyright ©2004
Developpez LLC. Tout droits réservés Developpez LLC.
Aucune reproduction, même partielle, ne peut être faite de ce site et de
l'ensemble de son contenu : textes, documents et images sans l'autorisation
expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à 3 ans
de prison et jusqu'à 300 000 E de dommages et intérets.
Cette page est déposée à la SACD.
|
