Recherche de fichier

**isis1be** · 31/01/2008, 11h52

Salut à tous

Dans une userForm j'ai ajouté une Textbox pour pouvoir rechercher des fichiers excell dans un dossier précis j'ai donc ajouté le code suivant sur le bouton de recherche

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
Private Sub btnchercher_Click()
    Dim Fichier As String
 
    ListBoxResult.Clear  'on vide en premier
 
    'recherche du fichier dans le répertoire
    Fichier = Dir("C:\Documents and Settings\Vinc\Bureau\")
 
    Do While Fichier <> ""
    'UCase pour s'assurer d'une bonne comparaison entre les chaînes
        If UCase(Fichier) Like "*" & UCase(ZoneRech.Value) & "*.XLS" Then
            ListBoxResult.AddItem Fichier
        End If
        Fichier = Dir  ' Recherche suivante
    Loop
 
    'On spécifie l'Index à afficher seulement si la liste n'est pas vide
    If ListBoxResult.ListCount > 0 Then ListBoxResult.ListIndex = 0
End Sub

Mais j'aimerais lorsque je change d'ordinateur ne pas devoir changer le chemin d'accès

Code :

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

Fichier = Dir("C:\Documents and Settings\Vinc\Bureau\")

Je sais que pour le faire je doit utiliser le "path" mais je ne sais pas comment on l'utilise.
Si quelqu'un pouvais me renseigner.
Merci à tous et @++

**fred65200** · 31/01/2008, 22h49

bonjour

une solution parmi d'autres

Code :

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

1
2
CheminBureau = Environ("USERPROFILE") & Application.PathSeparator & _
                "Desktop" & Application.PathSeparator

tu peux aussi utiliser SHGetSpecialFolderLocation et SHGetPathFromIDList de l'API avec CSIDL_DESKTOP en paramètre.

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
 Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
 Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
 
 Type SHITEMID
 cb As Long
 abID As Byte
 End Type
 
 Type ITEMIDLIST
 mkid As SHITEMID
 End Type
 
 'Constantes
 Global Const NOERROR = 0
 Global Const CSIDL_DESKTOP = &H0 '{desktop}
 Global Const CSIDL_INTERNET = &H1 'Internet Explorer (icon on desktop)
 Global Const CSIDL_PROGRAMS = &H2 'Start Menu\Programs
 Global Const CSIDL_CONTROLS = &H3 'My Computer\Control Panel
 Global Const CSIDL_PRINTERS = &H4 'My Computer\Printers
 Global Const CSIDL_PERSONAL = &H5 'My Documents
 Global Const CSIDL_FAVORITES = &H6 '{user}\Favourites
 Global Const CSIDL_STARTUP = &H7 'Start Menu\Programs\Startup
 Global Const CSIDL_RECENT = &H8 '{user}\Recent
 Global Const CSIDL_SENDTO = &H9 '{user}\SendTo
 Global Const CSIDL_BITBUCKET = &HA '{desktop}\Recycle Bin
 Global Const CSIDL_STARTMENU = &HB '{user}\Start Menu
 Global Const CSIDL_DESKTOPDIRECTORY = &H10 '{user}\Desktop
 Global Const CSIDL_DRIVES = &H11 'My Computer
 Global Const CSIDL_NETWORK = &H12 'Network Neighbourhood
 Global Const CSIDL_NETHOOD = &H13 '{user}\nethood
 Global Const CSIDL_FONTS = &H14 'windows\fonts
 Global Const CSIDL_TEMPLATES = &H15
 Global Const CSIDL_COMMON_STARTMENU = &H16 'All Users\Start Menu
 Global Const CSIDL_COMMON_PROGRAMS = &H17 'All Users\Programs
 Global Const CSIDL_COMMON_STARTUP = &H18 'All Users\Startup
 Global Const CSIDL_COMMON_DESKTOPDIRECTORY = &H19 'All Users\Desktop
 Global Const CSIDL_APPDATA = &H1A '{user}\Application Data
 Global Const CSIDL_PRINTHOOD = &H1B '{user}\PrintHood
 Global Const CSIDL_LOCAL_APPDATA = &H1C '{user}\Local Settings _
 '\Application Data (non roaming)
 Global Const CSIDL_ALTSTARTUP = &H1D 'non localized startup
 Global Const CSIDL_COMMON_ALTSTARTUP = &H1E 'non localized common startup
 Global Const CSIDL_COMMON_FAVORITES = &H1F
 Global Const CSIDL_INTERNET_CACHE = &H20
 Global Const CSIDL_COOKIES = &H21
 Global Const CSIDL_HISTORY = &H22
 Global Const CSIDL_COMMON_APPDATA = &H23 'All Users\Application Data
 Global Const CSIDL_WINDOWS = &H24 'GetWindowsDirectory()
 Global Const CSIDL_SYSTEM = &H25 'GetSystemDirectory()
 Global Const CSIDL_PROGRAM_FILES = &H26 'C:\Program Files
 Global Const CSIDL_MYPICTURES = &H27 'C:\Program Files\My Pictures
 Global Const CSIDL_PROFILE = &H28 'USERPROFILE
 Global Const CSIDL_SYSTEMX86 = &H29 'x86 system directory on RISC
 Global Const CSIDL_PROGRAM_FILESX86 = &H2A 'x86 C:\Program Files on RISC
 Global Const CSIDL_PROGRAM_FILES_COMMON = &H2B 'C:\Program Files\Common
 Global Const CSIDL_PROGRAM_FILES_COMMONX86 = &H2C 'x86 Program Files\Common on RISC
 Global Const CSIDL_COMMON_TEMPLATES = &H2D 'All Users\Templates
 Global Const CSIDL_COMMON_DOCUMENTS = &H2E 'All Users\Documents
 Global Const CSIDL_COMMON_ADMINTOOLS = &H2F 'All Users\Start Menu\Programs _
 '\Administrative Tools
 Global Const CSIDL_ADMINTOOLS = &H30 '{user}\Start Menu\Programs _
 '\Administrative Tools
 Global Const CSIDL_FLAG_CREATE = &H8000& 'combine with CSIDL_ value to force
 'create on SHGetSpecialFolderLocation()
 Global Const CSIDL_FLAG_DONT_VERIFY = &H4000 'combine with CSIDL_ value to force
 'create on SHGetSpecialFolderLocation()
 Global Const CSIDL_FLAG_MASK = &HFF00 'mask for all possible flag values
 Global Const SHGFP_TYPE_CURRENT = &H0 'current value for user, verify it exists
 Global Const SHGFP_TYPE_DEFAULT = &H1
 
 Global Const MAX_PATH = 260
 Global Const S_OK = 0
'-------------------------------------
Sub TestCherche_Chemin()
 
Debug.Print Cherche_Chemin(&H10)
End Sub
'-------------------------------------
Public Function Cherche_Chemin(Param As Long) As String
 Dim RetVal As Long
 Dim Path As String ' déclaration des variables nécessaires
 Dim IDL As ITEMIDLIST
 
 RetVal = SHGetSpecialFolderLocation(0, Param, IDL) ' appel de la fonction api
If RetVal = NOERROR Then
 Path = Space(512) ' taille du tampon
 RetVal = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path)
 Cherche_Chemin = Left(Path, InStr(Path, Chr(0)) - 1) ' extraction du chemin
Else
 Cherche_Chemin = ""
End If
 End Function

ou

lire une valeur dans la base de registre mais je ne me souviens pas de la clé HKEY_CURRENT_USER\........

et d'autres qui m'échappent

cordialement

**isis1be** · 11/02/2008, 10h27

Je te remercie de ton aide et m'excuse du temps de réaction, mais je travail en même temps

Ta première solution pour donner le chemin du bureau de l'utilisateur m'intéresse

Code :

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

1
2
CheminBureau = Environ("USERPROFILE") & Application.PathSeparator & _
                "Desktop" & Application.PathSeparator

si je comprend bien (car je ne suis vraiment pas calé en vba

)

il faut que je remplace ma variable fichier par CheminBureau donc ce sera?

Code :

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

Dim CheminBureau as string

mais le reste c'est un peu flou:

Environ :il faut que je déclare une nouvel variable?
USERPROFILE: La je suppose que je doit mettre le nom de l'utilisateur et de session?

Comme tu voit je suis nouveau en vba, je te remercie de ton aide et à très bientôt.

**fred65200** · 11/02/2008, 20h27

Bonjour

regarde l'exemple ci-dessous, tu comprendra certainement mieux,
n'hésite pas à consulter "Environ" dans l'aide

Code :

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

1
2
3
4
5
Sub Test()
Dim Fichier as string
Fichier = Environ("USERPROFILE") & Application.PathSeparator & _
                "Desktop" & Application.PathSeparator
msgbox Fichier

Tu devras peut être remplacer Desktop par Bureau

Cordialement

**ucfoutu** · 11/02/2008, 21h30

Bonsoir,

Pour éviter ces différences (bureau ou desktop) et mettre son appli à l'abri (en cas de distribution) des différentes versions :

utiliser la fonction SHGetSpecialFolderLocation de la librairie shell32 de l'Api de Windows, en conjpnction avec la constante CSIDL_DESKTOP dont la valeur est à fixer à &H0

Il suffit alors d'appeler une fonction du genre :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Function GetSpecfold(CSIDL As Long) As String
  'pour renvoyer le nom donné à un fichier spécial spécifié par CSIDL
  Dim res As Long
  Dim IDL As ITEMIDLIST '(voir cette structure publique dans common.bas)
  res = SHGetSpecialFolderLocation(100, CSIDL, IDL) 'SHGetSpecialFolderLocation déclarée dans le code de cette feuille
  If ra = 0 Then
    chem$ = Space$(512)
    res = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal chem$) ' SHGetPathFromIDList déclarée dans le code de cette feuille
    GetSpecfold = Left$(chem, InStr(chem, Chr$(0)) - 1) ' le nom complet du fichier spécial spécifié par CSIDL
    Exit Function
  End If
  GetSpecfold = ""
End Function

qui retournera le chemin du bureau...

**isis1be** · 12/02/2008, 11h34

désolé ucfoutu, mais comme je suis néophite en vba je ne comprend pas du tout ton code.

Maintenant j'ai fait les modifications dans mon code avec ce que tu me disais fred65200

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
Private Sub btnchercher_Click()
    Dim Fichier As String
 
    ListBoxResult.Clear  'on vide en premier
 
    'recherche dans le répertoire qu'on veut
    'Dir("C:\Documents and Settings\Vinc\Bureau\")
 
    Fichier = Environ("USERPROFILE") & Application.PathSeparator & _
                "Desktop" & Application.PathSeparator
 
    Do While Fichier <> ""
    'UCase pour s'assurer d'une bonne comparaison entre les chaînes
        If UCase(Fichier) Like "*" & UCase(ZoneRech.Value) & "*.XLS" Then
            ListBoxResult.AddItem Fichier
        End If
        Fichier = Dir  ' Recherche suivante
    Loop
 
    'On spécifie l'Index à afficher seulement si la liste n'est pas vide
    If ListBoxResult.ListCount > 0 Then ListBoxResult.ListIndex = 0
End Sub