[AC-2007] Choisir le répertoire de sauvegarde pour une exportation [Résolu]

[neiluj26]

Bonjour le forum,

Je voudrais laisser à mes utilisateurs le choix de choisir le fichier vers lequel ils veulent exporter des formulaires. En fouinant un peu, j'ai trouvé ce code (mille excuses à l'auteur dont j'ai effacé le nom et que je ne retrouve pas).

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Function ChoisirDossierDeSauvegarde()
 
'------ Cette fonction demande à l'utilisateur de choisir le répertoire dans lequel il veut sauvegarder son exportation.
 
Dim ObjShell As Object, ObjFolder As Object
Dim Message As String, strChemin As String
 
Message = "Choisissez le répertoire dans lequel vous voulez sauvegarder le fichier:"
 
Set ObjShell = CreateObject("Shell.Application")
Set ObjFolder = ObjShell.BrowseForFolder(&H0&, Message, 1)
 
On Error Resume Next 'Si on sort sans sélection
strChemin = ObjFolder.ParentFolder.ParseName(ObjFolder.Title).Path & ""
ChoisirDossierDeSauvegarde = strChemin
 
End Function

Au clic sur un bouton, j'obtiens cette fenêtre et l'utilisateur choisit son répertoire, puis le reste de mon code fait l'exportation.
Le problème est que si mon utilisateur clique sur "Mes Documents", la fonction renvoie une variable strChemin vide, et que je ne comprends pas pourquoi.
Est-ce que ça vous est déjà arrivé? Ou est-ce que vous avez un autre code qui me permettrait en plus de laisser à l'utilisateur de choisir le nom de l'exportation (Dossier machin.xls, par exemple)?

[LedZeppII]

Bonjour,

Essaie en remplaçant la ligne

Code :

strChemin = ObjFolder.ParentFolder.ParseName(ObjFolder.Title).Path & ""

par

Code :

strChemin = ObjFolder.Self.Path

Pour ta dernière question essaie (Access 2002 minimum)

Code :

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
Function EnregistrerSous(Optional sTitre As String, _
                          Optional sDossier As String, _
                          Optional sFichier As String) As String
 
Dim fdlg As Object
Dim strFichEnrSous As String
' Remarque : Pas de filtres possibles en mode SaveAs
'            il n'y a que *.*
Set fdlg = Application.FileDialog(2)  ' 2 = msoFileDialogSaveAs
' Mode vue liste
fdlg.InitialView = 1 ' 1 = msoFileDialogViewList
' Paramètres - Valeurs par défaut
If Len(sTitre) = 0 Then sTitre = "Exporter sous"
If Len(sDossier) = 0 Then sDossier = CurrentProject.Path
If Len(sFichier) = 0 Then sFichier = "Nom Par Defaut.csv"
' Chemin et nom par défaut
fdlg.InitialFileName = sDossier & "\" & sFichier
' Titre de la boîte de dialogue
fdlg.Title = sTitre
' Ouverture de la boîte de dialogue
If fdlg.Show Then
   strFichEnrSous = fdlg.SelectedItems(1)
End If
' Valeur de retour de la fonction
EnregistrerSous = strFichEnrSous
' Liberation variable objet
Set fdlg = Nothing
End Function

A+

[neiluj26]

Bonjour,

Super, ton code me convient parfaitement. C'est bien mieux que ma solution actuelle. Merci.

[_developpeur_]

Envoyé par LedZeppII

Bonjour,

Essaie en remplaçant la ligne

Code :

strChemin = ObjFolder.ParentFolder.ParseName(ObjFolder.Title).Path & ""

par

Code :

strChemin = ObjFolder.Self.Path

Pour ta dernière question essaie (Access 2002 minimum)

Code :

A+

Bonjour LedZeppII, quel est la différence entre ton code et celui donné par neiluj26 ? Je n'ai pas bien saisi la question de neiluj26 ?
Je te demande ça car je dois aussi afficher une boite de dialog pour choisir un repertoire.

Merci

[neiluj26]

Bonjour,

Il faut sûrement adapter, mais j'ai ajouté cette ligne de code à la fin au cas où mon utilisateur efface l'extension.

Code :

If InStr(InStrRev(strFichEnrSous, "\", , vbTextCompare), strFichEnrSous, ".", vbTextCompare) = 0 Then strFichEnrSous = strFichEnrSous & ".xlsx"

Quant à la différence entre les deux codes... mon code ne faisait qu'ouvrir une fenêtre de sélection de répertoire assez moche, et ne permettait pas de trouver le nom donné au fichier à sauvegarder.
La solution de LedZeppII permet d'ouvrir la fenêtre Enregistrer Sous "habituelle" et de pouvoir retrouver le nom donné au fichier sauvegardé par l'utilisateur. C'est bien plus complet.

[_developpeur_]

Envoyé par neiluj26

Bonjour,

Il faut sûrement adapter, mais j'ai ajouté cette ligne de code à la fin au cas où mon utilisateur efface l'extension.

Code :

If InStr(InStrRev(strFichEnrSous, "\", , vbTextCompare), strFichEnrSous, ".", vbTextCompare) = 0 Then strFichEnrSous = strFichEnrSous & ".xlsx"

Quant à la différence entre les deux codes... mon code ne faisait qu'ouvrir une fenêtre de sélection de répertoire assez moche, et ne permettait pas de trouver le nom donné au fichier à sauvegarder.
La solution de LedZeppII permet d'ouvrir la fenêtre Enregistrer Sous "habituelle" et de pouvoir retrouver le nom donné au fichier sauvegardé par l'utilisateur. C'est bien plus complet.

OK merci Neiluj26

[_developpeur_]

Bonjour, devant utiliser la fonctionnalité qui consiste a choisir le dossier de sauvegarde, je me penche sur la question, et en parcourant le forum, j'ai trouvé ce post :
http://www.developpez.net/forums/d17...s/explorateur/

Le code du lien ci-dessus est un peu plus complexe, je me demande donc quelle différence y a t-il avec celui de neiluj pour savoir lequel je dois utiliser ?

Il utilise des librairie alors que celui de neiluj non. Est ce que celui de neiluj fonctionnera sur n'importe quel type de windows de versions access etc...

Merci de votre aide.
a bientot.

David

[LedZeppII]

Bonjour,

Pour moi, les deux codes pour choisir un dossier sont identiques.

Argyronet fait appel aux fonctions de l'API Windows.
Cela nécessite des déclarations (Private Declare ...) pour que VBA sache comment appeler les fonctions et dans quelle dll les trouver.

neiluj26 fait appel à l'objet Shell.Application (Microsoft Shell Controls And Automation) qui inclut une méthode pour appeler, vraisemblablement, la même fonction.
Le travail est "prémaché" et plus simple en VBA avec Shell.Application.
neiluj26 n'utilise pas de référence VBA, mais on peut en mettre une à "Microsoft Shell Controls And Automation".
Au lieu d'écrire ...

Code :

1
2
3
Dim ObjShell As Object
 
Set ObjShell = CreateObject("Shell.Application")

... on écrirait (avec la référence VBA) ...

Code :

1
2
3
Dim ObjShell As Shell32.Shell
 
Set ObjShell = New Shell32.Shell

Les deux méthodes sont, à mon avis, sensibles à la version de Windows.

A+

[_developpeur_]

Envoyé par LedZeppII

Les deux méthodes sont, à mon avis, sensibles à la version de Windows.

Bonjour LedZeppII, est-ce que cela veut dire que selon la version de windows, ces deux codes peuvent ou non fonctionner?
Si oui lequel de ces deux codes fonctionnera sur tous les windows.
J'avoue avoir une préférence pour le code de neiluj bien plus simple...
Merci

[LedZeppII]

Bonjour _developpeur_,

J'aurai une préférence pour la méthode de neiluj, moi aussi.
Elle est plus simple.
Elle est peut-être moins dépendante de la version de Windows, mais ça je ne peut pas le vérifier.
Ce dont je suis un peu plus sûr, c'est que la version avec API fonctionne avec un Windows 32-bits,
mais risque de pas fonctionner avec un Windows 64-bits et Acces 64-bit (voir Développer avec Office 64 bits).

Il y a une autre possiblité.
A partir d'Access 2003 (à vérifier; Ok avec 2007) on peut utiliser FileDialog.
L'affichage est un peu différent de celui de BrowseForFolder.

En ajoutant une référence VBA à Microsoft Office xx.x Object Library :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Function ChoisirDossier(Optional sTitre As String, _
                        Optional sDossier As String) As String
Dim fdlg As Office.FileDialog
Dim strDossier As String
 
Set fdlg = Application.FileDialog(msoFileDialogFolderPicker)
' Paramètres - Valeurs par défaut
If Len(sTitre) = 0 Then sTitre = "Sélectionnez un dossier"
If Len(sDossier) = 0 Then sDossier = CurrentProject.Path & "\"
' Chemin par défaut
fdlg.InitialFileName = sDossier
' Titre boîte de dialogue
fdlg.Title = sTitre
' Interdire sélection multiple
fdlg.AllowMultiSelect = False
' Ouvrir boîte de dialogue
If fdlg.Show Then
   strDossier = fdlg.SelectedItems(1)
End If
' Libérer variable objet
Set fdlg = Nothing
' Valeur de retour de la fonction
ChoisirDossier = strDossier
End Function

Sans référence VBA à Microsoft Office xx.x Object Library :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Function ChoisirDossier(Optional sTitre As String, _
                        Optional sDossier As String) As String
Dim fdlg As Object
Dim strDossier As String
 
Set fdlg = Application.FileDialog(4) ' 4 = msoFileDialogFolderPicker
' Paramètres - Valeurs par défaut
If Len(sTitre) = 0 Then sTitre = "Sélectionnez un dossier"
If Len(sDossier) = 0 Then sDossier = CurrentProject.Path & "\"
' Chemin par défaut
fdlg.InitialFileName = sDossier
' Titre boîte de dialogue
fdlg.Title = sTitre
' Interdire sélection multiple
fdlg.AllowMultiSelect = False
' Ouvrir boîte de dialogue
If fdlg.Show Then
   strDossier = fdlg.SelectedItems(1)
End If
' Libérer variable objet
Set fdlg = Nothing
' Valeur de retour de la fonction
ChoisirDossier = strDossier
End Function

A+

[_developpeur_]

Bonjour LedZepp, merci beaucoup je vais prendre ta dernière solution sans références.
Encore merci