Discussion :

[marycaLou]

Bonjour,

J'ai une macro (qu'un ancien collègue a écrite) qui nous permet d'enregistrer un courriel dans un dossier.
J'aimerais savoir comment faire pour que ma fenêtre qui me demande dans quel dossier enregistrer mon courriel affiche les raccourcis qu'il y a dans un dossier X.

Exemple: Sur mon bureau, j'ai 3 raccourcis pour des dossiers sur notre serveur (Raccourcis1, raccourcis 2 et raccourcis3). Je veux prendre un courriel dans MsOutlook et le classer dans le raccourcis 2.

Dans la programmation de cettemacro, le code suivant ouvre la fenêtre du bureau mais elle n'affiche pas mes raccourcis.
Voici le code:

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
 
 Dim myOlApp As Object
    Dim FileSaveName As Variant
    Dim FolderName As String
    Dim NUM_PROJ As String
    Dim FileName As String
    Dim ShellApp As Object
    Dim EMAIL As MailItem      
    '-----------------------------------------------------------------------
    ' Indique le dossier par défaut lors du lancement de la macro.
    ' Si vous désirez changer le dossier par défaut,
    '    modifier "= 0" pour tout autre endroit désiré. Exemple: "= C:\"
    '-----------------------------------------------------------------------
    OpenAt = 0            ' Modifier l'ouverture du dossier par défaut.
    'OpenAt = 0            ' OUVERTURE STANDARD SOUS LE BUREAU
    'OpenAt = "C:\"       ' OUVRIR DIRECTEMENT SOUS LE C:
    '                             (OU N'IMPORTE QUEL RACCOURCI)
    '-----------------------------------------------------------------------
    '-----------------------------------------------------------------------
 
 
    'Create a file browser window at the default folder
'    Set ShellApp = CreateObject("Shell.Application").BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
    Set ShellApp = CreateObject("Shell.Application").BrowseForFolder(0, "S.V.P. Choisir un dossier :", 0, OpenAt)
 
    'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.path
    'Destroy the Shell Application
    Set ShellApp = Nothing
 
    If BrowseForFolder = "" Then Exit Function
    FolderName = BrowseForFolder & "\"

Comment faire pour afficher aussi mes raccourcis?

Merci.

[Oliv-]

Bonjour,
tu ne pourras pas avec BrowseFolder developper un raccourci(lnk).
Si tu veux l'utiliser quand même tu dois modifier
OpenAt = 0 par le chemin de ton dossier.

Si tu as le choix entre 3 raccourcis et ton pc tu peux avant d'afficher BrowseForFolder afficher un userform avec des boutons radio qui vont définir ton OpenAT selon ce premier choix.

Sinon tu peux utiliser ce code

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
Function BrowseFolderExplorer(Optional DialogTitle As String, _
    Optional ViewType As MsoFileDialogView = _
        MsoFileDialogView.msoFileDialogViewSmallIcons, _
    Optional InitialDirectory As String) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' BrowseFolderExplorer
' This provides an Explorer-like Folder Open dialog.
' http://www.cpearson.com/excel/browsefolder.aspx
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim fDialog  As Office.FileDialog
    Dim varFile As Variant
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    fDialog.InitialView = ViewType
    With fDialog
        If Dir(InitialDirectory, vbDirectory) <> vbNullString Then
            .InitialFileName = InitialDirectory
        Else
            .InitialFileName = CurDir
        End If
        .Title = DialogTitle
 
        If .Show = True Then
            ' user picked a folder
            BrowseFolderExplorer = .SelectedItems(1)
        Else
            ' user cancelled
            BrowseFolderExplorer = vbNullString
        End If
    End With
End Function
 
 
 
 
Sub testBrowseFolderExplorer()
MsgBox BrowseFolderExplorer
End Sub

[marycaLou]

Bonjour,

Comme je ne suis pas l'auteure de cette macro et que je ne suis pas experte dans les macros, je n'ai pas très bien compris ce que vous voulez dire.

Ce que je sais, c'est que ceux qui utilisent cette macro peuvent avoir plusieurs raccourcis sur leur bureau et voudraient les utiliser plutôt que de dérouler tout le chemin sur le serveur pour atteindre le dossier XYZ dans lequel ils veulent classer leur courriel.

Si je veux faire ce que vous disiez "...avant d'afficher BrowseForFolder afficher un userform avec des boutons radio qui vont définir ton OpenAT selon ce premier choix" Comment fait-on. Y aurait-il un tutoriel qui pourrait me l'expliquer.

Si non, J'ai recopié le code que vous avez mis, mais j'aurais besoin de savoir comment appeler la procédure. J'ai été sur le lien qu'il y a dans le code. Mais j'ai besoin de l'étudier un peu car je ne comprends pas tout surtout que c'est en anglais.

Merci

[Oliv-]

Bonsoir
Il manque ce qu il y a avant ta ligne 1
Est ce une fonction ou une partie de sub?
Mais à priori tu remplaces tout par

Code :

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

1
2
3
 
Foldername= BrowseFolderExplorer("choisissez la destination")
' on peut aussi mettre le type de vue et le dossier par défaut

edit il faut peut etre ajouter une référence à *"Microsoft Office 1x.x object library"

[Oliv-]

Bonjour,
En fait je me suis un peu avancé trop vite cette fonction marche avec Exce mais pas avec Outlook.

Mais on peut contourner le pb ainsi :

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
Function BrowseFolderExplorer(Optional DialogTitle As String, _
    Optional ViewType As MsoFileDialogView = _
        MsoFileDialogView.msoFileDialogViewSmallIcons, _
    Optional InitialDirectory As String) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' BrowseFolderExplorer
' This provides an Explorer-like Folder Open dialog.
' http://www.cpearson.com/excel/browsefolder.aspx
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim fDialog  As Office.FileDialog
    Dim varFile As Variant
    Dim ExcelApp
    Set ExcelApp = CreateObject("Excel.application")
    ExcelApp.Visible = True
    'ExcelApp.WindowState = -4140
 
    Set fDialog = ExcelApp.FileDialog(msoFileDialogFolderPicker)
    fDialog.InitialView = ViewType
    With fDialog
        If Dir(InitialDirectory, vbDirectory) <> vbNullString Then
            .InitialFileName = InitialDirectory
        Else
            .InitialFileName = CurDir
        End If
        .Title = DialogTitle
 
        If .Show = True Then
            ' user picked a folder
            BrowseFolderExplorer = .SelectedItems(1)
        Else
            ' user cancelled
            BrowseFolderExplorer = vbNullString
        End If
    End With
    ExcelApp.Quit
End Function
 
 
 
 
Sub testBrowseFolderExplorer()
MsgBox BrowseFolderExplorer
End Sub

[marycaLou]

Bonjour
J'ai essayé le code ci-dessus. Mais c'est toujours Excel qui s'ouvre. Moi je suis dans Outlook.

Est-ce qu'il y a moyen de le faire dans Outlook?

Merci.

[Oliv-]

Salut
Excel permet juste de renvoyer y nom de dossier utilisable dans outlook

[marycaLou]

Désolé.

En effet là j'ai réussi à avoir des raccourcis sauf qu'on dirait qu'il perd le lien avec Outlook.
J'ai un message d'erreur qui s'affiche à la ligne 72 (voir le code ci-dessous) " DeQui = Mail.SenderName". Voici le message: "Erreur d'exécution 424 Objet requis".

Si j'enlève le code ajouté (ligne46) et que je réactive les lignes33 à 42, la ligne 72 fonctionne bien.

Voici mon code:

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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
 
Private Function CLASS(TYPE_REVISION As String)
    Dim INIT As String
    Dim stnom As String
 
    '-----------------------------------------------------------------------
    ' ADAPTER LE PARAMÈTRE CI-DESSOUS POUR PERSONNALISER LA NOMENCLATURE
    '-----------------------------------------------------------------------
        INIT = "LoP"                    ' Inscrire vos Initiales.
        stnom = "Mon nom"     ' Inscrire votre nom.
    '-----------------------------------------------------------------------
    Dim myOlApp As Object
    Dim FileSaveName As Variant
    Dim FolderName As String
    Dim NUM_PROJ As String
    Dim FileName As String
    Dim ShellApp As Object
    Dim EMAIL As MailItem
    Dim DeQui As String  ' de qui vient le courriel. LP
 
    '-----------------------------------------------------------------------
    ' Indique le dossier par défaut lors du lancement de la macro.
    ' Si vous désirez changer le dossier par défaut,
    '    modifier "= 0" pour tout autre endroit désiré. Exemple: "= C:\"
    '-----------------------------------------------------------------------
    OpenAt = 0            ' Modifier l'ouverture du dossier par défaut.
                          ' OUVERTURE STANDARD SOUS LE BUREAU
    'OpenAt = "C:\"       ' OUVRIR DIRECTEMENT SOUS LE C:
    '                             (OU N'IMPORTE QUEL RACCOURCI)
    '-----------------------------------------------------------------------
    '-----------------------------------------------------------------------
 
'  *** code avant qui n'affiche pas les raccourcis ***
    'Create a file browser window at the default folder
'    Set ShellApp = CreateObject("Shell.Application").BrowseForFolder(0, "S.V.P., Choisir le dossier :", BIF_BROWSEINCLUDEFILES, OpenAt)
'
'    'Set the folder to that selected.  (On error in case cancelled)
'    On Error Resume Next
'    BrowseForFolder = ShellApp.self.path
'    'Destroy the Shell Application
'    Set ShellApp = Nothing
'  *** FIN  du code avant qui n'affiche pas les raccourcis ***
 
    ' *********** ajout du code pour afficher les raccourcis:   
 '          que vous m'avez proposé.
    BrowseForFolder = BrowseFolderExplorer
 
    ' *****************************
' code que j'avais et qui fonctionne: 
 
    If BrowseForFolder = "" Then Exit Function
    FolderName = BrowseForFolder & "\"
    ' Modifications pour nouveaux projets 2012-02-29 LP
    If Mid(FolderName, (InStr(FolderName, "\P0") + 1), 3) = "P00" Then
         NUM_PROJ = UCase(Mid(FolderName, (InStr(FolderName, "\P0") + 1), 7))
     ElseIf UCase(Mid(FolderName, (InStr(FolderName, "\B-0") + 1), 4)) = "B-00" Then
               NUM_PROJ = UCase(Mid(FolderName, (InStr(FolderName, "\B-0") + 1), 9))
     ElseIf UCase(Mid(FolderName, (InStr(FolderName, "\P-0") + 1), 4)) = "P-00" Then
          NUM_PROJ = UCase(Mid(FolderName, (InStr(FolderName, "\P-0") + 1), 9))
     ElseIf UCase(Mid(FolderName, (InStr(FolderName, "\GC-0") + 1), 4)) = "GC-0" Then
          NUM_PROJ = UCase(Mid(FolderName, (InStr(FolderName, "\GC-0") + 1), 10))
     ElseIf UCase(Mid(FolderName, (InStr(FolderName, "\RG-0") + 1), 4)) = "RG-0" Then
          NUM_PROJ = UCase(Mid(FolderName, (InStr(FolderName, "\RG-0") + 1), 10))
    Else
          NUM_PROJ = UCase(Mid(FolderName, (InStr(FolderName, "\P0") + 1), 7))
    End If
 
    NUM_PROJ = InputBox("Veuillez valider le numéro de projet.", "Numéro de projet", NUM_PROJ)
    If NUM_PROJ = "" Then Exit Function
 
 ' *******  L'Erreur est ici
    DeQui = Mail.SenderName
 
 
 'Active Outlook
    Set myOlApp = CreateObject("Outlook.Application")
 
    Set SEL_ORI = myOlApp.ActiveExplorer.Selection
 
    Set folder = myOlApp.ActiveExplorer.Selection.Item(1).Parent
 
    For i = 1 To folder.Folders.Count
        If folder.Folders.Item(i).Name = "Classé" Then ok = True
    Next
    For i = 1 To folder.Folders.Count
        If folder.Folders.Item(i).Name = "Classé" Then ok = True
    Next
 
       ' ******************************
    '   pour ne pas avoir le dossier CLASSÉ, MAJ 2012-02-02 LP
    '    If ok = False Then
    '        Set backupfolder = folder.Folders.Add("Classé")
    '    Else
    '        Set backupfolder = folder.Folders.Item("Classé")
    '    End If
    ' **********************
 
    If ok = False Then
        Set backupfolder = folder.Folders.Add("Classé")
    Else
        Set backupfolder = folder.Folders.Item("Classé")
    End If
 
    For i = 1 To SEL_ORI.Count Step 1
 
        Set EMAIL = SEL_ORI.Item(i)
 
        FileName = FolderName & SetFileName(EMAIL, FolderName, NUM_PROJ, INIT, TYPE_REVISION, DeQui, stnom)
 
          ' **********************
    '   pour ne pas avoir le dossier CLASSÉ, MAJ 2012-02-02 LP
    '    EMAIL.Move backupfolder
        ' **********************
        ' MAJ 2012-11-15 LP
        If Len(FileName) > 255 Then
                MsgBox "L'objet du courriel est trop long. La commande a été annulée"
                Exit Function
        End If
 
 
        EMAIL.Move backupfolder
        'Enregistre le fichier
        EMAIL.SaveAs FileName, olMSG
        ' **********************
    '   pour ne pas avoir le dossier CLASSÉ, MAJ 2012-02-02 LP
        '  EMAIL.Delete
        ' **********************
    Next
End Function
'Donne le bon nom au courriel
Private Function SetFileName(Mail As MailItem, FolderName As String, NUM_PROJ As String, INIT As String, TYPE_REVISION As String, DeQui As String, stnom As String) As String
    ' MAJ 2011-02-07 LP
.....
 
Sub VInitial()
' procédure appeler par la macro
    Dim TYPE_REVISION As String
    TYPE_REVISION = "V"
    Call CLASS(TYPE_REVISION)
End Sub

Comment faire pour corriger l'erreur qui s'affiche.

Merci.

[marycaLou]

Bonjour,

Finalement, je crois avoir trouvé. J'ai modifié la ligne comme ci

Code :

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

    DeQui = ""         ' Mail.SenderName - MAJ 2014-01-19 LP

Puisque ma variable DeQui est définie plus loin dans mon code, il n'était pas nécessaire de l'initialiser au début.

Merci beaucoup pour votre aide.

[GiantJack44]

Bonjour,

Je cherche à développer une macro Outlook qui ressemble assez à celle décrite dans cette conversation.
Je précise ma demande :
> tout d'abord, je suis (encore) sur Outlook 2007 (1ère différence notable)
> je souhaite sauvegarder des mails (au format msg) dans une répertoire de mon choix
> pour cela je souhaiterais pouvoir sélectionner mon répertoire de destination par l'intermédiaire d'une boîte de navigation/exploration des répertoires
> je souhaiterais également pouvoir accéder aux éventuels raccourcis de répertoires de mon arborescence

> cerise sur le gâteau : j'aimerais pouvoir associer le lancement de cette macro à un glissé-déplacé du(des) mail(s) de mon choix vers le répertoire/raccourci de mon choix

Je m'en remets à vos bons conseils

[Oliv-]

SAlut,
c'est mieux de créer ton propre sujet !

[GiantJack44]

Bonjour,

Etant donné que c'était sur le même thème, je pensais que c'était pertinent de compléter la conversation. Mais ok, je vais de ce pas créer un autre sujet.