Fonction qui ouvre une sous répertoire et change le chemin

Bonjour ! j'ai écris un code qui me permet d'ouvrir le centre de dialogue et selectionner un dossier nommé "VBA", dans ce dossier se trouve un autre dossier qui est nommé "Daten". J'ai des difficulté à écrire un code qui me permet d'ouvrir le sous-dossier "Daten" et actualiser le chemin "strPath" qui deviendrai "C:/VBA/Daten"

If Tabelle7.Range("B4").Value = "" Then    'If the cell B4 is empty:

    Set fileExplorer = Application.FileDialog(msoFileDialogFolderPicker)

    'To allow or disable to multi select
    fileExplorer.AllowMultiSelect = False
    With fileExplorer
        If .Show = -1 Then 'Any folder is selected
            strPath = .SelectedItems.Item(1)
        Else ' else dialog is cancelled
            MsgBox "You have cancelled the dialogue"
            End
            strPath = "" ' when cancelled set blank as file path.

        End If
    End With

Merci Beaucoup

Bonjour,

Avec la boite de dialogue, si le dossier existe, vous le sélectionnez tout simplement !

If Tabelle7.Range("B4").Value = "" Then    'If the cell B4 is empty:
strfilename = "????"

    Set fileExplorer = Application.FileDialog(msoFileDialogFolderPicker)

    With fileExplorer
        .AllowMultiSelect = False 'To allow or disable to multi select
        If .Show = -1 Then
            strPath = .SelectedItems.Item(1)
        Else ' else dialog is cancelled
            MsgBox "You have cancelled the dialogue"
            exit sub
        End If
    End With

    strFullpath = strPath & "\" & strfilename

Cdlt,

Salut 3G, meric pour ta réponse. J'aimerai bien le selectionner directement mais je devrai pas. je devrai selectionner le dossier VBA et apres mettre un Inputbox pour demander si les fichier devraient être recherché aussi dans les sous dossiers, si la réponse est "oui" mon strPath doit s'actualiser et fini sur le sous dossier "Daten".. :/

Pouvez-vous essayer ceci ? Ici, je considère qu'il n'y a que Daten comme sous-dossier.

If Tabelle7.Range("B4").Value = "" Then    'If the cell B4 is empty:

Set fileExplorer = Application.FileDialog(msoFileDialogFolderPicker)

With fileExplorer 'avec folderpicker
    .show = true 'afficher
    .AllowMultiSelect = False 'To allow or disable to multi select
    If not .SelectedItems.count = 1 Then 'si selection <> 1
        MsgBox "You have cancelled the dialogue" 'msg
        exit sub 'sortie
    Else 'sinon
        strPath = .SelectedItems.Item(1) 'chemin = répertoire sélectionné
        if  strPath = "C:\VBA" then 'si chemin = "C:\VBA"
            if msgbox("Voulez-vous enregistrer le fichier dans le sous-dossier Daten ?", vbyesno, "Choix du répertoire") = vbyes then
'si on répond oui à la demande d'enregistrer dans Daten
                strPath = strPath & "\Daten" 'chemin actualisé avec Daten
            end if
        end if
    End If
End With

Mais honnêtement, je ne comprends pas bien pourquoi avoir une boite de dialogue de sélection de dossiers si ce n'est pas pour sélectionner le bon dossier directement. Sinon, on peut directement choisir définir le chemin sans boite de dialogue selon des conditions...

Cdlt,

Merci beaucoup pour ta réponse! je comprend moi aussi pas pourquoi mais c'est l'exercice qui veut ca haha. Merci encore :)

Ah c'est un exercice, d'accord ...

Et il faut absolument une inputbox alors ? Voici un autre petit essai, ce n'est pas testé donc à voir.

If Tabelle7.Range("B4").Value = "" Then    'If the cell B4 is empty:

Set fileExplorer = Application.FileDialog(msoFileDialogFolderPicker)

With fileExplorer 'avec folderpicker
    .show = true 'afficher
    .AllowMultiSelect = False 'To allow or disable to multi select
    If not .SelectedItems.count = 1 Then 'si selection <> 1
        MsgBox "You have cancelled the dialogue" 'msg
        exit sub 'sortie
    Else 'sinon
        strPath = .SelectedItems.Item(1) 'chemin = répertoire sélectionné
        if  strPath = "C:\VBA" then 'si chemin = "C:\VBA"
            strSubfolder = inputbox("Veuillez indiquer le sous-dossier :") 'saisir sous-dossier
            if strSubfolder <> "" and not dir(strPath & "\" & strSubfolder, vbdirectory) = "" then
                strPath = strPath & "\" & strSubFolder 'chemin actualisé avec sous-dossier
            else
                msgbox "le sous-dossier n'existe pas, le répertoire retenu sera : " & strPath
            end if
        end if
    End If
End With

Cdlt,

Merci beaucoup 3GB ca marche nickel, petit probleme juste si le prof telecharge le code et l'ouvre chez lui, son strPath sera différent et le programme va lui donner une petite erreur haha mais bon :/

Oui mais c'est pour ça que c'est etrange... Comment savoir à l'avance quel répertoire sera sélectionné et avoir la garantie qu'il contienne un dossier Daten ?

J'enlève alors la condition pour que ce soit plus général avec gestion d'erreur (oubliée sur le précédent) au cas où et l'organisation retouchée :

If Tabelle7.Range("B4").Value = "" Then    'If the cell B4 is empty:

Set fileExplorer = Application.FileDialog(msoFileDialogFolderPicker)

With fileExplorer 'avec folderpicker
    .show = true 'afficher
    .AllowMultiSelect = False 'To allow or disable to multi select
    If not .SelectedItems.count = 1 Then 'si selection <> 1
        MsgBox "You have cancelled the dialogue" 'msg
        exit sub 'sortie
    Else 'sinon
        strPath = .SelectedItems.Item(1) 'chemin = répertoire sélectionné
    end if
end with

strSubfolder = inputbox("Veuillez indiquer le sous-dossier :") 'saisir sous-dossier
on error resume next 'passer le cas où le sous-dossier n'existe pas (générateur d'erreur dans le Dir)
if strSubfolder = "" or dir(strPath & "\" & strSubfolder, vbdirectory) = "" then 'si input vide ou annulée ou sousdossier inexistant
    err.clear 'nettoie erreur liée au sous-dossier
    msgbox "le sous-dossier n'existe pas, le répertoire retenu sera : " & strPath 'msg
else
    strPath = strPath & "\" & strSubFolder 'sinon, chemin actualisé avec sous-dossier
end if

Normalement, ça devrait être plus général comme ça.

Cdlt,

Ca marche parfaitement merci ernormement pour le temps que t'a consacré pour m'aider! <3

Je t'en prie, je suis content que ç amarche !

Bonne continuation à toi !