Trouver un dossier avec une macro

Bonjour à tous,

J'aimerais trouver directement un dossier avec une macro. Je sais faire pour trouver un fichier, mais pour un dossier j'ai rien réussi de bien pour l'instant....!!!

Merci à vous

Bonjour,

Et hop, une petite fonction...

Function SelectionRepertoire() As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Choisir un répertoire :"
        .Show
        If .SelectedItems.Count = 1 Then SelectionRepertoire = .SelectedItems(1)
    End With
End Function

Merci Frank...

J'essaie demain car je suis out of office en cette fin aprem...

merci à toi et je te tiens au courant...

Désolé Pijaku, pas Frank... Je ne sais pas où je suis allé chercher Frank

Désolé Pijaku, pas Frank... Je ne sais pas où je suis allé chercher Frank

Dans ma signature. Franck est bien mon prénom

Bonjour Pijaku,

Désolé, je n'ai pas eu le temps de m'y remettre avant.

Voilà la macro que j'ai écrite avec ta fonction

Sub ouvrir_dossier_client()

Function SelectionRepertoire() As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choisir un répertoire :sDossier"
.Show
If .SelectedItems.Count = 1 Then SelectionRepertoire = .SelectedItems(1)
End With
End Function
Ici:
nomcli = Application.InputBox("ECRIRE NOM CLIENT SANS SE PREOCCUPER DE LA CASSE")
If nomcli = False Then
GoTo Ici
End If
Dim sDossier As String
reponse = MsgBox("C'est un client Nord ou Sud. Si NORD Clickez sur 'YES' - Si SUD Clickez sur 'NO'", vbYesNo, "OUVRIR RAPPORT PCR CLIENT")
If reponse = vbYes Then
sDossier = "C:\Users\Miche\OneDrive\Documents\c.P.C.R\aa.Clients\Clients Nord" & "\" & nomcli
Else
sDossier = "C:\Users\Miche\OneDrive\Documents\c.P.C.R\aa.Clients\Clients Sud" & "\" & nomcli
End If
If Dir(sDossier) = "" Then
MsgBox "Le Dossier " & " " & "n'existe pas. La Procédure va Recommencer.", vbExclamation
Exit Sub
End If
End Sub

Quand je veux faire le pas à pas détaillé, il me met "attendu End Sub"

Je suis largué... Merci d'avance... Bonne journée

Bonjour,

Normal.

Tu as :

Function ...

DU CODE ICI

End Function

DU CODE ICI

End Sub

Manque une ligne : Sub MachinChose(). Comme ceci :

Function SelectionRepertoire() As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choisir un répertoire :sDossier"
.Show
If .SelectedItems.Count = 1 Then SelectionRepertoire = .SelectedItems(1)
End With
End Function
'-----------------------------ICI :
Sub MachinTRuc()
Ici:
nomcli = Application.InputBox("ECRIRE NOM CLIENT SANS SE PREOCCUPER DE LA CASSE")
If nomcli = False Then
  GoTo Ici
End If
Dim sDossier As String
reponse = MsgBox("C'est un client Nord ou Sud. Si NORD Clickez sur 'YES' - Si SUD Clickez sur 'NO'", vbYesNo, "OUVRIR RAPPORT PCR CLIENT")
If reponse = vbYes Then
  sDossier = "C:\Users\Miche\OneDrive\Documents\c.P.C.R\aa.Clients\Clients Nord" & "\" & nomcli
Else
  sDossier = "C:\Users\Miche\OneDrive\Documents\c.P.C.R\aa.Clients\Clients Sud" & "\" & nomcli
End If
If Dir(sDossier) = "" Then
  MsgBox "Le Dossier " & " " & "n'existe pas. La Procédure va Recommencer.", 
vbExclamation
  Exit Sub
End If
End Sub

Mais, du coup, je ne vois pas bien à quoi sert ma fonction...

Merci à toi

C'est certainement moi qui n'ai pas compris...

Avec ta fonction, il n'y a pas besoin d'indiquer de chemin de répertoire... ??? La macro trouve le dossier direct... ???

En ce cas, c'est moi qui suis complètement à côté de la plaque...

Essaye, dans ton code, de remplacer :

sDossier = "C:\Users\Miche\OneDrive\Documents\c.P.C.R\aa.Clients\Clients Nord" & "\" & nomcli

par :

sDossier = SelectionRepertoire & "\" & nomcli

OK, je fais ça cet aprem..

Merci à toi

J'ai réessayé pas mal de choses...

Mais le problème est que ta fonction demande toujours le nom du dossier même si je l'ai donné par sDossier. Et quand je rentre le nom du dossier, j'ai toujours le message "Le chemin d'accès n'existe pas"

Voilà... Bonne soirée....

Bonjour,

Copie-colle ce code, puis lance la Sub MachinTruc...

Option Explicit

Sub MachinTRuc()
Dim nomcli As String, sDossier As String, reponse As Integer
    Do
        nomcli = Input_Box("ECRIRE NOM CLIENT SANS SE PREOCCUPER DE LA CASSE", "CLIENT", "Annulation")
    Loop While nomcli = vbNullString And nomcli <> "Annulation"
    MsgBox "Votre saisie : " & nomcli
    If nomcli <> "Annulation" Then
        sDossier = SelectionRepertoire("Choisir un répertoire. Exemple : C:\Users\Miche\OneDrive\Documents\c.P.C.R\aa.Clients\Clients Nord")
        sDossier = sDossier & "\"
        MsgBox "Votre choix de répertoire : " & vbLf & sDossier & nomcli
        If Dir(sDossier) = "" Then
            MsgBox "Le Dossier " & " " & "n'existe pas. La Procédure va Recommencer.", vbExclamation
            Exit Sub
        End If
    End If
End Sub

Private Function Input_Box(sMessage As String, Optional sTitre As String, Optional sAnnule As String = "Annulation", _
                            Optional sDefaut As String, Optional iPosX As Integer, Optional iPosY As Integer, _
                                Optional sFichierAide As String, Optional iContext As Integer) As String
Dim iVar As Variant
    iVar = InputBox(sMessage, sTitre, sDefaut, iPosX, iPosY, sFichierAide, iContext)
    If StrPtr(iVar) = 0 Then
        MsgBox "Vous avez annulé", vbCritical + vbOKOnly, "Annulation utilisateur"
        Input_Box = sAnnule
    ElseIf iVar = vbNullString Then
        MsgBox "Aucune saisie", vbCritical + vbOKOnly, "Pas de saisie utilisateur"
        Input_Box = vbNullString
    Else
        Input_Box = iVar
    End If
End Function

Private Function SelectionRepertoire(Titre As String) As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = Titre
        .Show
        If .SelectedItems.Count = 1 Then SelectionRepertoire = .SelectedItems(1)
    End With
End Function

Bonjour Frank,

Merci de ta réponse.

Je rencontre un problème avec "Option Explicit"

Il ne veut pas que je le mette avant macro machin chose. Il me le met avec la macro d'avant. Et forcément, il me dit "Uniquement des commentaires après End Sub".

J'ai essayé de le mettre juste avant fonction, mais il ne veut pas non plus...

Désolé, je te fais beaucoup bosser avec cette Macro.

Veux-tu que je t'envoie le Fichier ????

Bonne journée, Bien cordialement,

Michel

Option Explicit doit toujours être placé en entête du Module.

C'est la première ligne d'instruction d'un module.

Bonjour Frank,

Désolé de ne pas t'avoir donné de nouvelles mais j'ai été souffrant.

Donc je viens de mettre la macro dans un nouveau module.

Mais au final, elle me demande toujours de retrouver le dossier dans l'explorateur.

elle ne va pas dessus.

Cela a l'ai compliqué. Si cette macro ne fonctionne pas, ce n'est pas très grave pour moi. C'était une cerise sur le gâteau.

A toi de voir.

Bonne fin d'aprem,

Michel

Bonjour,

Ok. Je comprends mieux la demande.

A essayer :

Sub MachinTRuc()
Dim nomcli As String, sDossier As String, reponse As Integer
    Do
        nomcli = Input_Box("ECRIRE NOM CLIENT SANS SE PREOCCUPER DE LA CASSE", "CLIENT", "Annulation")
    Loop While nomcli = vbNullString And nomcli <> "Annulation"

    If nomcli <> "Annulation" Then
        reponse = MsgBox("C'est un client Nord ou Sud. Si NORD Clickez sur 'YES' - Si SUD Clickez sur 'NO'", vbYesNo, "OUVRIR RAPPORT PCR CLIENT")
        If reponse = vbYes Then
            sDossier = SelectionRepertoire("Choisir un répertoire.", "Nord", nomcli)
        Else
            sDossier = SelectionRepertoire("Choisir un répertoire.", "Sud", nomcli)
        End If
        sDossier = sDossier
        MsgBox "Votre choix de répertoire : " & vbLf & sDossier
        If Dir(sDossier, vbDirectory) = "" Then
            MsgBox "Le Dossier " & sDossier & " n'existe pas. La Procédure va Recommencer.", vbExclamation
            Exit Sub
        End If
    End If
End Sub

Private Function Input_Box(sMessage As String, Optional sTitre As String, Optional sAnnule As String = "Annulation", _
                            Optional sDefaut As String, Optional iPosX As Integer, Optional iPosY As Integer, _
                                Optional sFichierAide As String, Optional iContext As Integer) As String
Dim iVar As Variant
    iVar = InputBox(sMessage, sTitre, sDefaut, iPosX, iPosY, sFichierAide, iContext)
    If StrPtr(iVar) = 0 Then
        MsgBox "Vous avez annulé", vbCritical + vbOKOnly, "Annulation utilisateur"
        Input_Box = sAnnule
    ElseIf iVar = vbNullString Then
        MsgBox "Aucune saisie", vbCritical + vbOKOnly, "Pas de saisie utilisateur"
        Input_Box = vbNullString
    Else
        Input_Box = iVar
    End If
End Function

Private Function SelectionRepertoire(Titre As String, NordOuSud As String, Client As String) As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = Titre
        .InitialFileName = "C:\Users\Miche\OneDrive\Documents\c.P.C.R\aa.Clients\Clients " & NordOuSud & "\" & Client
        .Show
        If .SelectedItems.Count = 1 Then SelectionRepertoire = .SelectedItems(1)
    End With
End Function

Bonjour Frank,

j'ai fait le copier / coller mais ça ne fonctionne toujours pas.

Tu sais, je crois que l'on va simplifier le truc car ce sera déjà super pour moi.

On ne va chercher qu'à ouvrir le répertoire client Nord ou client Sud.

De là, je choisis mon dossier client.

Car, ce qui m'intéresse vraiment dans cette macro, c'est de ne pas passer par l'explorateur pour trouver mon dossier.

Si je tombe direct sur le bon répertoire, c'est déjà super...

Bon dimanche, Merci à toi,

Amicalement, Michel