Equivalent de Filedialog sous Excel 2000

[Reskibil]

Bonjour à tous,

Mon problème est le suivant :
J'ai fait un fichier sous excel XP qui marche nickel. Entre autre chose, il permet de faire apparaitre une boite dans laquelle on selectionne le dossier dans lequel on veut enregistrer un fichier texte (bon deja si vous avez suivi jusque la, c'est pas mal).
Mais hélas, l'os c'est qu'au final, ce fichier sera utilisé sous Excel 2000 et bien sur, Filedialog ? Connais po !
Alors j'ai cherché un peu sur le net et j'ai trouvé un truc qui marche (enfin, qui affiche le chemin du dossier selectionné) sauf qu'en l'occurence, y'a 100 lignes de code avec des déclarations de trucs ... bref, usine a gaz. Auriez-vous quelquechose de plus simple et adaptable sous la main ?

Pour info, le code initial :

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Dim choix As Variant
With fd
If .Show = -1 Then
For Each choix In .SelectedItems
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile(choix & "\" & "base.txt", True)
MsgBox "Base SMS créée dans : " & choix
Next choix
Set fd = Nothing
Else
GoTo fin
End If
End With

Alors si quelqu'un à une idée qui marche (et si en plus c'était simple, j'en jubilerais)

Merci d'avance

 

[Sylvain]

bonsoir,

pourquoi pas chercher ici :
<http://www.excelabo.net/xl/repertoires.php>

déclaration
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long


Utilisation :

Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Choisissez un dossier de destination pour les sauvegardes."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory & "\"
Else
GetDirectory = ""
End If
End Function

A+

 

[Ti]

On peut se passer de ces usines à gaz en utilisant un simple Application.GetSaveAsFilename, dont l'aide de donnera un exemple d'utilisation facilement reproductible. En trois lignes, c'est fait !

 

[Reskibil]

Merci pour vos réponse
J'avais trouvé la solution de Sylvain sur le net mais effectivement c'est un peu usine a gaz et surtout ca se met dans un module or j'en avait besoin sur un bouton de userform
Mais j'ai quand meme opté pour cette solution qui marche tres bien en executant la fin du code de mon bouton dans le module
J'esperais juste qu'il existait une fonction plus simple equivalent a filedialog qui tient en quelques lignes mais le principal c'est que ca marche meme sur une machine faiblarde