Discussion :

[SR.SFC]

Bonjour,

Dans une programmation VBA pour Outlook, je cherche les instructions
pour pouvoir sélectionner un répertoire, et, un (voire plusieurs) fichier.

J'ai essayé l'instruction
Application.FileDialog(msoFileDialogFolderPicker)
qui me renvoie une erreur
Erreur d'éxécution '438': Propriété ou méthode non géré par cet objet.

Il est pourtant possible de sélectionner un fichier pour ajouter une pièce jointe.

Merci à ceux qui aurait une idée.

[Franc]

Salut, voici comment tu peux faire:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub ChoisirFichiers()
    Dim xlApp As Object
    Dim fd As Object
    Dim i As Integer
 
    Set xlApp = CreateObject("Excel.Application")
    Set fd = xlApp.FileDialog(3) ' 3 = msoFileDialogFilePicker
 
    With fd
        .AllowMultiSelect = True
        .Title = "Sélectionnez un ou plusieurs fichiers"
        .Filters.Clear
        .Filters.Add "Tous les fichiers", "*.*"
 
        If .Show = -1 Then ' Si OK est cliqué
            For i = 1 To .SelectedItems.Count
                MsgBox "Fichier sélectionné : " & .SelectedItems(i)
            Next i
        Else
            MsgBox "Aucun fichier sélectionné."
        End If
    End With
 
    Set fd = Nothing
    Set xlApp = Nothing
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub ChoisirDossier()
    Dim shellApp As Object
    Dim dossier As Object
 
    Set shellApp = CreateObject("Shell.Application")
    Set dossier = shellApp.BrowseForFolder(0, "Choisissez un dossier", 0, 0)
 
    If Not dossier Is Nothing Then
        MsgBox "Dossier sélectionné : " & dossier.Items().Item().Path
    Else
        MsgBox "Aucun dossier sélectionné."
    End If
End Sub

Assures-toi que "Microsoft Office Object Library" est activé.

[Valtrase]

Bonsoir à tous,
Et si vous voulez une seule fonction.
Celle-ci est minimaliste et vous permet de sélectionner soit un ou des fichiers ainsi qu'un répertoire. Coller le code dans un module.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
Public Enum vaFileDialogFilterType
    AllFile
    ExcelFile
    HtmlFile
    ImagesFile
    PdfFile
End Enum
 
'@Description "Ouvrir le sélecteur de dossiers."
Public Function GetFileOrFolderName( _
       Optional ByVal InitialPath As String = vbNullString, _
       Optional ByVal FileDialogType As Office.MsoFileDialogType = msoFileDialogFolderPicker, _
       Optional ByVal FilterType As vaFileDialogFilterType = AllFile, _
       Optional ByVal AllowMultiSelect As Boolean = False _
       ) As Variant
 
    On Error GoTo catch
 
    Dim localFileDialog As Office.FileDialog
    Set localFileDialog = Application.FileDialog(FileDialogType)
    With localFileDialog
        .Filters.Clear
 
        If FileDialogType = msoFileDialogFolderPicker Then
            .Title = "Sélectionnez un dossier..."
        Else
            .Title = "Sélectionnez le" & _
                     IIf(AllowMultiSelect, "(s)", vbNullString) & _
                     "fichier" & IIf(AllowMultiSelect, "(s)", vbNullString) & " de destination."
 
            .AllowMultiSelect = AllowMultiSelect
 
            Select Case FilterType
                Case AllFile
                    .Filters.Add "Tous les fichiers", "*.*", 1
                Case ExcelFile
                    .Filters.Add "Documents Excel", "*.xls; *.xlsx; *.xlsm; *.xlst; *.xlsb; *.csv", 1
                Case ImagesFile
                    .Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.png; *.bmp", 1
                Case HtmlFile
                    .Filters.Add "Documents Htm", "*.Htm; *.Html", 1
                Case PdfFile
                    .Filters.Add "Fichiers Adobe PDF", "*.pdf; *.pdx; *.bpdx; *.fcdt; *.fdf", 1
            End Select
 
        End If
 
        .InitialView = msoFileDialogViewList
        If InitialPath = vbNullString Then
            .InitialFileName = ThisWorkbook.Path
        Else
            .InitialFileName = IIf(Right$(.InitialFileName, 1) <> "\", "\", vbNullString)
        End If
 
        If .Show Then
            If AllowMultiSelect = False Then
                GetFileOrFolderName = .SelectedItems(1)
            Else
                Dim TempTab() As String
                ReDim TempTab(1 To .SelectedItems.Count)
                Dim Counter As Long
                For Counter = 1 To .SelectedItems.Count
                    TempTab(Counter) = .SelectedItems(Counter)
                Next Counter
                GetFileOrFolderName = TempTab
            End If
        Else
            GetFileOrFolderName = False
        End If
    End With
 
catch:
    If Err.Number <> 0 Then
        MsgBox "Erreur " & Err.Number & " (" & Err.Description & ")" & vbCrLf & _
               "Dans la procédure 'GetFileOrFolderName'"
        GetFileOrFolderName = False
    End If
    If Not localFileDialog Is Nothing Then Set localFileDialog = Nothing
End Function

Et une procédure pour le test :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Public Sub Test101()
    ' // Sélection d'un seul fichier
    Dim MyFile As Variant
    MyFile = GetFileOrFolderName( _
             InitialPath:=ThisWorkbook.Path, _
             FileDialogType:=msoFileDialogFilePicker, _
             FilterType:=PdfFile, _
             AllowMultiSelect:=False _
                                )
        If Not MyFile = False Then
            MsgBox MyFile
        Else
            MsgBox "Commande annulée par l'utilisateur!"
        End If
 
    ' // Sélection de plusieurs fichiers
    Dim MyFiles As Variant
    MyFiles = GetFileOrFolderName( _
              InitialPath:=ThisWorkbook.Path, _
              FileDialogType:=msoFileDialogFilePicker, _
              FilterType:=PdfFile, _
              AllowMultiSelect:=True _
                                 )
 
    If IsArray(MyFiles) Then
        Dim item As Variant
        Dim Message As String
        Message = "Fichiers sélectionnés : " & vbNewLine & vbNewLine
        For Each item In MyFiles
            Message = Message & item & vbNewLine
        Next item
        MsgBox Message
    Else
        If Not MyFiles = False Then
            MsgBox MyFiles
        Else
            MsgBox "Commande annulée par l'utilisateur!"
        End If
    End If
 
    ' // Sélection d'un répertoire
    Dim MyFolder As Variant
    MyFolder = GetFileOrFolderName( _
               InitialPath:=ThisWorkbook.Path _
                             )
        If Not MyFolder = False Then
            MsgBox "Dossier sélectionné : " & vbNewLine & vbNewLine & MyFolder
        Else
            MsgBox "Commande annulée par l'utilisateur!"
        End If
End Sub

Bonne programmation...

[modus57]

Bonjour bon 1er Mai & bonne chance @ tous,
Voici une autre possibilité:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub ChoixDossier()
    Dim folderPath As String
    Dim folderExists As Boolean
    ' Ouvrir la boîte de dialogue pour sélectionner un dossier
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Sélectionnez un dossier"
        .AllowMultiSelect = False
        If .Show = -1 Then ' Si un dossier est sélectionné
            folderPath = .SelectedItems(1)
            MsgBox "Le dossier sélectionné : " & folderPath, vbInformation
        Else
            MsgBox "Aucun dossier sélectionner" , vbExclamation
            Exit Sub
        End If
    End With
End Sub

Ne pas oublier d'activer "Microsoft Scripting Runtine" dans référence VBAProject