[VBA] Sélection d'un fichier à partir d'une racine

Le
HD
Bonjour,

Anciennement j'utilisai une macro pour sélectionner un fichier à partir
d'une racine

Function ChoixDossierFichier(Racine, Optional SelType As Byte = 0)
Dim objShell, objFolder, Chemin, SecuriteSlash, FlagChoix&, Msg$

If SelType = 0 Then
FlagChoix = &H1&: Msg = "Choisissez un dossier :"
Else
FlagChoix = &H4000&: Msg = "Choisissez un fichier :"
End If

Set objShell = CreateObject("Shell.Application")
'le troisième paramètre permet de choisir
'la sélection d'un dossier (0) ou d'un fichier (1)
'le dernier paramètre permet de choisir le dossier racine
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, FlagChoix,Racine)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).path & ""
If objFolder.Title = "" Then
Chemin = ""
End If

SecuriteSlash = InStr(objFolder.Title, ":")

If SecuriteSlash > 0 Then
Chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If
ChoixDossierFichier = Chemin
End Function

Mon problème est que cette macro plante de manière quasiment systèmatique
dès que l'on sélectionne un fichier à la racine de la racine précisée
J'ai alors un message "Erreur d'exécution '-2147024894 (80070002)': La
méthode 'BrowseForFolder' de l'objet 'IShellDispatch4' a échoué."

J'ai le problème sur mon poste avec Excel 2007 et Windows XP SP3 Le
problème se posait déja avec XP SP2. Je ne sais si cela vient de la version
d'Excel ou de la version Windows Je n'ai pas de références manquantes

Savez vous d'où peut venir le problème ? Et si l'on ne peut pas le résoudre
auriez vous une macro équivalente fonctionnant sous de nombreuses
configurations (Excel et Windows) ?

--
@+
HD
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Daniel.C
Le #19201981
Bonjour.
Comment fais-tu pour remonter "à la racine de la racine" ?
Daniel

Bonjour,

Anciennement j'utilisai une macro pour sélectionner un fichier à partir d'une
racine...

Function ChoixDossierFichier(Racine, Optional SelType As Byte = 0)
Dim objShell, objFolder, Chemin, SecuriteSlash, FlagChoix&, Msg$

If SelType = 0 Then
FlagChoix = &H1&: Msg = "Choisissez un dossier :"
Else
FlagChoix = &H4000&: Msg = "Choisissez un fichier :"
End If

Set objShell = CreateObject("Shell.Application")
'le troisième paramètre permet de choisir
'la sélection d'un dossier (0) ou d'un fichier (1)
'le dernier paramètre permet de choisir le dossier racine
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, FlagChoix,Racine)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).path & ""
If objFolder.Title = "" Then
Chemin = ""
End If

SecuriteSlash = InStr(objFolder.Title, ":")

If SecuriteSlash > 0 Then
Chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If
ChoixDossierFichier = Chemin
End Function

Mon problème est que cette macro plante de manière quasiment systèmatique dès
que l'on sélectionne un fichier à la racine de la racine précisée... J'ai
alors un message "Erreur d'exécution '-2147024894 (80070002)': La méthode
'BrowseForFolder' de l'objet 'IShellDispatch4' a échoué."

J'ai le problème sur mon poste avec Excel 2007 et Windows XP SP3... Le
problème se posait déja avec XP SP2. Je ne sais si cela vient de la version
d'Excel ou de la version Windows... Je n'ai pas de références manquantes...

Savez vous d'où peut venir le problème ? Et si l'on ne peut pas le résoudre
auriez vous une macro équivalente fonctionnant sous de nombreuses
configurations (Excel et Windows) ?


FFO
Le #19202101
Salut à toi

Si j'ai bien compris la finalité de ce code il récupère d'abord l'adresse
d'un répertoire puis avec cette adresse celle d'un fichier sélectionné dans
ce répertoire

Dans cet esprit je te propose ce code à mettre dans le VBA de la feuille :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
If Target = "" Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Title = "Veuillez choisir le Dossier"
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Target = ChoixDossier
Else
If Target Like "*:*" Then
ChDrive (Left(Target, 1))
ChDir Range(Target.Address)
Fichier = Application.GetOpenFilename(, , "Veuillez choisir le ficher")
If Fichier <> "Faux" Then
Target = Fichier
End If
End If
End If
End Sub

Par un double click d'une cellule vide une boîte de dialogue demandera à
choisir un dossier
Son adresse sera recopié dans cette cellule
Puis par un nouveau double click une nouvelle boîte de dialogue dans ce
dossier demandera à choisir un fichier
Son adresse sera recopiée dans cette cellule

Celà correspond il à ton attente

Dis moi !!!!
Publicité
Poster une réponse
Anonyme