VBA Boite de dialogue choix de répertoire

[Pyton]

Bonjour à tous et merci d'avance pour votre aide.

Voici mon problème, je veux permettre aux utilisateur de mon fichier, d'utiliser une boite de dialogue windows pour sélectionner un fichier texte (.rtf) qui se situe dans un dossier spécifique.

Le code 1 c'est ce que je veux.
Je ne sais pas si je suis près d'une solution ou si je suis complètement dans le "décord"
Code 1 ne fonctionne pas quand je veux accéder à un dossier qui est situé sur le réseau.

Sub test1()
'fonctionne Pas
'Mais c'est ce que je veux

Dim a As String

   ChDrive "\\MonOrdi\Document" 'Choix du répertoire à ouvrir Sur Réseau
   a = Application.GetOpenFilename("Fichier Texte (*.rtf), *.rtf", , _
        "Sélection de vos fichiers Texte", , True)

   If Not a = "" Then Range("A1").Value = a

End Sub

Code 2 ne fonctionne mais ne s'affiche pas au répertoire que je veux.

Sub test2()
'fonctionne mais la boite de dialogue ne s'ouvre pas au répertoire demandé
   Dim a As String

   ChDrive "C:\Users\Sylvain\Documents" 'Choix du répertoire à ouvrir Sur le disque C
   a = Application.GetOpenFilename("Fichier Texte (*.rtf), *.rtf", , _
        "Sélection de vos fichiers Texte", , True)

   If Not a = "" Then Range("A1").Value = a

End Sub

Merci encore

 

[Roland_M]

Bonsoir,

ChDrive c'est pour activer un lecteur par sa lettre ChDrive "E"
ChDir c'est pour positionner sur le dossier ChDir "\abcd\efgh"
normalement ceci devrait fonctionner mais sur réseaux je sais pas si le ChDrive "\\" va fonctionner !?
à essayer et dire quoi !

Sub test1()
Dim A As String
ChDrive "\\"
ChDir "\\MonOrdi\Document"
A = Application.GetOpenFilename("Fichier Texte (*.rtf),*.rtf", Title:="Sélection de vos fichiers Texte", MultiSelect:=True)
If Not A = "" Then Range("A1").Value = A
End Sub

 

[Dranreb]

Bonsoir.

Et si ça ne marche pas il va falloir chercher l'API SettCurrentDirectory

#If VBA7 Then
    Private Declare PtrSafe Function SetCurrentDirectory Lib "kernel32" _
        Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
#Else
    Private Declare Function SetCurrentDirectory Lib "kernel32" _
        Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
#End If

If SetCurrentDirectory("\\MonOrdi\Document") = 0 Then MsgBox "Erreur": Exit Sub

 

[RoyalP]

voici une procedure qui liste tous les fichiers d'un repertoire (reseau y compris, je l'utilise sur notre reseau)

a toi d l'adapter pour tes besoins

Sub MainList()

'Listing et affichage dossier
Range("a2:A10000").ClearContents ' on selection la rangée a effacer
Set folder = Application.FileDialog(msoFileDialogFolderPicker)

If folder.Show <> -1 Then
MsgBox "Aucun Repertoire | Fichier Séléctionné"
Exit Sub
Else
xDir = folder.SelectedItems(1)

Call ListFilesInFolder(xDir, True)
End If
End Sub
Sub ListFilesInFolder(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean)
Dim xFileSystemObject As Object
Dim xFolder As Object
Dim xSubFolder As Object
Dim xFile As Object
Dim rowIndex As Long
' routine pour la progress bar
'   Application.ScreenUpdating = False 'fige l'écran
  '  UserForm1.Show vbModeless 'Affiche Barreprogression dans état modeless
'    xCompteurX = 0
  
Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFileSystemObject.GetFolder(xFolderName)
rowIndex = Application.ActiveSheet.Range("A65536").End(xlUp).Row + 1
For Each xFile In xFolder.Files
Call BarreDeProgression
  Application.ActiveSheet.Cells(rowIndex, 1).Formula = xFolder & "\" & xFile.Name
  rowIndex = rowIndex + 1
Next xFile
If xIsSubfolders Then
  For Each xSubFolder In xFolder.SubFolders
    ListFilesInFolder xSubFolder.Path, True
      Next xSubFolder

End If

Set xFile = Nothing
Set xFolder = Nothing
Set xFileSystemObject = Nothing

Application.Cursor = xlNormal
Unload UserForm1
End Sub
Function GetFileOwner(ByVal xPath As String, ByVal xName As String)
Dim xFolder As Object
Dim xFolderItem As Object
Dim xShell As Object
xName = StrConv(xName, vbUnicode)
xPath = StrConv(xPath, vbUnicode)
Set xShell = CreateObject("Shell.Application")
Set xFolder = xShell.Namespace(StrConv(xPath, vbFromUnicode))
If Not xFolder Is Nothing Then
  Set xFolderItem = xFolder.ParseName(StrConv(xName, vbFromUnicode))
End If
If Not xFolderItem Is Nothing Then
  GetFileOwner = xFolder.GetDetailsOf(xFolderItem, 8)
Else
  GetFileOwner = ""
End If
Set xShell = Nothing
Set xFolder = Nothing
Set xFolderItem = Nothing

End Function

 

[Roland_M]

Bonjour tout le monde,

salut à toi RoyalIP !
extraire les fichiers d'un répertoire sur disque dur ou d'un réseau ne pose pas de problème
lui, ce qu'il souhaite, c'est se placer directement sur le lecteur et le dossier pour éviter à l'utilisateur de naviguer dans l'arborescence

soit avec ChDrive et ChDir afin de sélectionner plusieurs fichiers au choix parmi ceux dans la boite de dialogue ...

donc il faut qu'il fasse un essai avec ChDrive car ChDir ne devrait pas poser de problème !
on ne peut malheureusement faire cet essai à la maison !

 

[RoyalP]

oui oui j'avais compris ca demande

voici ce que j'ai utilisé pour mon reseau ou j'etais en stage

a adapter selon tes besoin

Private Sub CommandButton1_Click() '
Dim nom_choisit As String, chemin As String, extension As String, extension1 As String, dossier As String, Fichier As String
nom_choisit = "*.rtf"

ChDrive "T" ' choix du repertoire sur le reseau
ChDir "\le reseau\le rep\encore un rep\" & nom_choisit ' a modifié par le chemin de ton reseau

dossier = "\" & nom_choisit
extension1 = "rtf" ' a modifier avec extension voulu
vFile = Application.GetOpenFilename("dossier,extension1", Title:=" Selectionnez le fichier")
  If vFile = False Then
    MsgBox "Aucun fichier Sélectionné."
  Else
ta procedure ou ce que tu veux faire
End If
End Sub

J'espere que ca pourra t'aider

 

[Pyton]

Merci à tous pour votre aide

J'ai tester vos solution avec "ChDrive" mais cela ne réussi pas à sélectionner un emplacement réseau. Donne "Erreur 68 périphérique non disponible"

J'ai essayer avec:

ChDrive "NOM_DE_L_ORDI"
ChDir "\le reseau\le rep\encore un rep\"

ChDrive "\NOM_DE_L_ORDI"
ChDir "\le reseau\le rep\encore un rep\"

ChDrive "\\"
ChDir "\le reseau\le rep\encore un rep\"

ChDrive ne parvient pas à accéder à un répertoire réseau.

Merci encore je cherche encore sur le forum et avec mon ami Google.

 

[Dranreb]

Et avec SetCurrentDirectory (voir poste #3) ?

 

[RoyalP]

c'est etonnant , moi ca fonctionne nickel sur le reseau ou je suis.

 

[Roland_M]

Bonjour,

salut RoyalIP !

l'accès au réseau s'effectue par "\\chemin...
quand tu dis ça fonctionne, comment fais tu pour le rendre actif ?
ChDrive "\\" < comme ceci ?

on peut accéder au réseau par les méthodes connues pour lire/écrire,
mais on ne peut le rendre actif puisqu'il ne fais pas parti du matériel propre au PC !

 

[Dranreb]

Bonjour.
Ça fonctionne peut être seulement si on a pris soin d'attribuer une lettre de lecteur au chemin réseau (je ne sais pas quels outils Windows on utilise pour faire ce truc là)
En tout cas je suis sur que l'API SetCurrentDirectory fonctionne avec des chemins de réseau commençant par "\\" et positionne à la fois le lecteur courant (ce que fait ChDrive quand il existe une lettre de lecteur) et CurDir pour ce lecteur là.
Qu'est ce que vous attendez pour l'essayer, bon sang, puisque ça marche à tous les coups !

Extraits d'aide Microsoft / Windows Dev Center / Support

SetCurrentDirectory function

Changes the current directory for the current process.

Syntax
C++

BOOL WINAPI SetCurrentDirectory(
_In_ LPCTSTR lpPathName
);

Parameters
lpPathName [in]
The path to the new current directory. This parameter may specify a relative path or a full path. In either case, the full path of the specified directory is calculated and stored as the current directory. For more information, see Ce lien n'existe plus.

…

Remarks
Each process has a single current directory made up of two parts:

• A disk designator that is either a drive letter followed by a colon, or a server name and share name (\\servername\sharename)
• A directory on the disk designator

 

[Roland_M]

Bonjour,

Salut Dranreb !
effectivement il faudrait que le demandeur fasse l'essai puisque lui a la possibilité de le faire !?

EDIT: maintenant, il lui est tout à fait possible d'extraire simplement la liste des fichiers et de choisir ses fichiers dans cette liste !
Point besoin de rendre le lecteur réseau actif pour ça !

 

[Pyton]

Bonjour,

Salut Dranreb!
J'ai essayé le code que tu as mis au poste 3 mais PtrSafe me pose problème (erreur de syntaxe ou sub non défini) et étant débutant comparer à vous tous, je suis perdu!
Bref je ne sais pas comment utiliser cette fonction! Les fonction que j'ai utiliser jusqu’à maintenant sont des copier coller. J'ai encore de la difficulté à comprendre la façon de les appeler.

Si je comprend le but de la fonction, c'est de renommer mon chemin réseau afin de pouvoir le récupérer? est-ce bien cela?

#If VBA7 Then
   Private Declare PtrSafe Function SetCurrentDirectory Lib "kernel32" _
        Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
#Else
   Private Declare Function SetCurrentDirectory Lib "kernel32" _
        Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
#End If

Merci d'éclairer mon chemin car il commence à s'assombrir.

 

[Dranreb]

Bonsoir.
Normalement, bien que signalée, l'erreur ne doit pas gêner parce que l'instruction est soumise à la directive de compilation conditionnelle #If VBA7 Then et la constante de compilation conditionnelle VBA7 n'est définie que sur les ordis avec CPU à 64bits de bus adresse.
Il y avait un exemple d'utilisation en dessous :

If SetCurrentDirectory("\\MonOrdi\Document") = 0 Then MsgBox "Erreur": Exit Sub

Non, ça remplace ChDrive / ChDir mais en acceptant un chemin réseau existant. Simplement c'est une Function plutôt qu'une Sub parce qu'elle retourne un code de bonne exécution différent de 0.

 

[Roland_M]

Bonjour tout le monde,

Salut Dranreb !

@Pyton, excuses, mais il faut tout de même te mâcher le travail !?

Alors, voilà tu ouvres Excel et tu fais "Insérer un Module" puis dedans tu colles ce code
La fonction de Dranreb qui doit se situer en haut du module !
La fonction de Dranreb qui sert de test du lecteur et du chemin !
Le Sub Essai() que j'ai mis pour toi comprendre le déroulement et faire les tests !

NE T'OCCUPES PAS des lignes en rouges, c'est normal !
NE FAIS PAS Débogage/Compilation ça va t'indiquer une erreur, ne t'en occupes pas, ça n'empêche pas le bon fonctionnement !
Dranreb s'échine à t'expliquer cela mais apparemment ...

Tu te places sur le Sub Essai() , tu entres le bon chemin, puis tu tapes F5 pour l'exécuter et tu reviens nous dire quoi !

Pour preuve que ça fonctionne tu tapes un chemin existant sur ton pc, exp si tu as "c:\temp" , et tu verras le résultat !
Je ne peux tester un réseau mais j'ai testé sur E:\TEMP qui existe chez moi et ça fonctionne !

Et pour répondre à ta question, non ça ne renomme pas mais ça active le lecteur/chemin,
c'est bien cela que tu voulais ?

'ceci remplace ChDrive et ChDir
#If VBA7 Then
    Private Declare PtrSafe Function SetCurrentDirectory Lib "kernel32" _
      Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
#Else
    Private Declare Function SetCurrentDirectory Lib "kernel32" _
      Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
#End If

'fonction pour activer et se placer sur un lecteur/chemin
Function ActiveLectChemin(C$) As Boolean
If SetCurrentDirectory(C$) <> 0 Then ActiveLectChemin = True Else ActiveLectChemin = False
End Function


'(1)INTRODUIRE LE BON CHEMIN  (2)TAPER F5 pour l'exécution
Sub Essai()
LectChemin$ = "\\MonOrdi\Document"
If ActiveLectChemin(LectChemin$) Then
   MsgBox LectChemin$ & vbLf & vbLf & "Ce chemin est activé !"
Else
   MsgBox LectChemin$ & vbLf & vbLf & "Ce chemin n'existe pas !"
End If
End Sub