Discussion :

[Noche]

Bonjour,

je revien vers vous car j'ai un petit souci au niveau de ma macro (mineur mais c'est toujours les petits problème les plus agaçant :p )

le souci est que quand je fais annuler sur ma boite de dialogue parcourir pour selectioner le répertoire de destination ce dernier lance la procédure malgré tout et envoi les mails dans un fichier source de outlook et quand j'envois X mail et que je me dit "a merde j'en est oublier ou ajouter en trop" ben mon reflexe est de cliqué sur annuler et le temps qu'il traitre tout ça j'ai perdu du temps :/. il faudrais donc m'expliquer comment faire pour annulé la suite du programme si je clique sur annulé

Après c'est pas un problème mais plus une amélioration. dans ma boite parcourir je ne vois pas les racourcie que je créer pour accéder plus rapidement au dossier ou je veux aller y a t-il un moyen d'y remèdier?

voici le code complet

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
Function BrowseForFolder(Title As String) As String
    Dim objShell   As Object
    Dim ssfWINDOWS As Long
    Dim objFolder  As Object
 
    ssfWINDOWS = 36
    Set objShell = CreateObject("Shell.Application")
 
        Set objFolder = objShell.BrowseForFolder(0, Title, 0, ssfWINDOWS)
            If (Not objFolder Is Nothing) Then
            BrowseForFolder = objFolder.self.Path & "\"
                'Add code here
            End If
        Set objFolder = Nothing
    Set objShell = Nothing
End Function
 
Sub sav_mail_as_msg(repertoire As String, Optional objCurrentMessage As Object)
 
    If objCurrentMessage Is Nothing Then Set objCurrentMessage = ActiveInspector.CurrentItem
    NomExport = Format$(objCurrentMessage.ReceivedTime, "yymmdd") & " - " & objCurrentMessage.SenderName & " - " & objCurrentMessage.Subject
 
    PathNomExport = repertoire & Left(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
    NomExport, "\", ""), "/", ""), ":", ""), "*", ""), "?", ""), "<", ""), ">", ""), "|", ""), ".", ""), """", ""), vbTab, ""), Chr(7), ""), 160) & ".msg"
    n = 1
    MemPath = PathNomExport
    While Dir(PathNomExport) <> ""
        PathNomExport = Left(MemPath, Len(MemPath) - 4) & "(" & n & ")" & ".msg"
        n = n + 1
 
    Wend
    objCurrentMessage.SaveAs PathNomExport, OlSaveAsType.olMSG
 
End Sub
 
 
Sub Save()
    Dim MonOutlook As Outlook.Application
    Dim LeMail As Object
    Dim LesMails As Outlook.Selection
    Dim repertoire As String
    Set MonOutlook = Outlook.Application
 
    Set LesMails = MonOutlook.ActiveExplorer.Selection
    repertoire = BrowseForFolder("Choisissez la destination")
    For Each LeMail In LesMails
       Call sav_mail_as_msg(repertoire, LeMail)
    Next LeMail
 
    Set LesMails = Nothing
    MsgBox "Fin de traitement"
End Sub

Merci par avance pour votre aide et vos connaissance

[carden752]

Bonjour,

Si tu annules, la valeur de BrowseForFolder est "" (Function BrowseForFolder) donc il te faut tester si c'est la même valeur pour répertoire (Procédure save) et si tel est le cas, soit demander de sélectionner un répertoire (appel en boucle à BrowseForFolder), soit ne pas faire une partie du traitement suivant.

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
Sub Save()
    Dim MonOutlook As Outlook.Application
    Dim LeMail As Object
    Dim LesMails As Outlook.Selection
    Dim repertoire As String
    Set MonOutlook = Outlook.Application
 
    Set LesMails = MonOutlook.ActiveExplorer.Selection
    repertoire = BrowseForFolder("Choisissez la destination")
if repertoire <> "" Then 
    For Each LeMail In LesMails
       Call sav_mail_as_msg(repertoire, LeMail)
    Next LeMail
 
    Set LesMails = Nothing
    MsgBox "Fin de traitement"
else 
msgbox "Pas de répertoire sélectionné"
end if
End Sub

[Noche]

effectivement cela marche nikel merci!

par contre pour voir les dossier raccourci que je créer sur mon bureau j'ai trouver ceci

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
Function BrowseForFolder(Title As String) As String
    Dim objShell   As Object
    Dim ssfWINDOWS As Long
    Dim objFolder  As Object
 
    Const conReturnOnlyFSDirs = &H1
    Const conNoNewFolderButton = &H200
    Const conBrowseIncludeFiles = &H4000
 
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, Title, conReturnOnlyFSDirs + conNoNewFolderButton + conBrowseIncludeFiles, ssfWINDOWS)
            If (Not objFolder Is Nothing) Then
            BrowseForFolder = objFolder.Self.Path & "\"
                'Add code here
            End If
        Set objFolder = Nothing
    Set objShell = Nothing
End Function

ceci me permet effectivement de les voirs MAIS pas de les parcourir et encore moi enregistrer dessus après coup je me demande si cela est bien possible d'améliorer

[carden752]

Bonjour,

Il faut regarder dans les options de BROWSEINFOStructure sur la MSDN si une option peut correspondre.
BROWSEINFO Structure

[Noche]

ouai y a pas a premiere vus le seul qui pourrai faire cela est la boite "save as" mais impossible de trouver comment en appeller une :/ bon pas grave merci deja pour le "annuler"