Discussion :

[wanou44]

Bonjour,

J'essaye de créer une macro qui me permettrait d'afficher la fenêtre "Enregistrer sous" avec un emplacement défini ainsi que le type de donnée (ici .msg).

J'ai déjà fait cette fonction dans Excel. J'ai essayé de l'adapter à Outlook mais ça ne fonctionne pas malgrés mes recherches sur Internet.
Voici ce que j'ai fait :

Code :

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

1
2
3
4
5
6
 
Sub enregistrer()
 
Application.Dialogs(olDialogSaveAs).Show
 
End Sub

Pouvez-vous m'aider s'il vous plait ?

[cafeine]

Hello,

pourquoi ne pas utiliser les fonctions API pour afficher les boîtes de dialogues ?

(dispo sur la FAQ Access du site)

[wanou44]

J'ai essayé d'utiliser les API mais ça ne fonctionne pas.
Il faut dire que je m'y connais pas trop en VBA. Je fais plutôt des fonctions très simples.

Voici ce que j'ai tapé :

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
 
Private Declare Function GetSaveFileName Lib "comdlg32.dll" _
        Alias "GetSaveFileNameAs" (pOpenfilename As OPENFILENAME) _
        As Long
 
 'Structure du fichier
Private Type OPENFILENAME
  lStructSize As Long
  hWndOwner As Long
  hInstance As Long
  lpstrFilter As String
  lpstrCustomFilter As String
  nMaxCustFilter As Long
  nFilterIndex As Long
  lpstrFile As String
  nMaxFile As Long
  lpstrFileTitle As String
  nMaxFileTitle As Long
  lpstrInitialDir As String
  lpstrTitle As String
  Flags As Long
  nFileOffset As Integer
  nFileExtension As Integer
  lpstrDefExt As String
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type
Function EnregistrerUnFichier(Handle As Long, Titre As String, _
                    NomFichier As String, Chemin As String) As String
 
 'EnregistrerUnFichier est la fonction a utiliser dans votre formulaire pour ouvrir _
la boîte de dialogue d'enregistrement d'un fichier.
 'Explication des paramètres
    'Handle = le handle de la fenêtre (Me.Hwnd)
    'Titre = Titre de la boîte de dialogue
    'NomFichier = Nom par défaut du fichier à enregistrer
    'Chemin = Chemin par défaut du fichier à enregistrer
 
Dim structSave As OPENFILENAME
 
With structSave
    .lStructSize = Len(structSave)
    .hWndOwner = Handle
    .nMaxFile = 255
    .lpstrFile = NomFichier & String$(255 - Len(NomFichier), 0)
    .lpstrInitialDir = Chemin
    .lpstrFilter = "Tous (*.*)" & Chr$(0) & "*.*" & Chr$(0) 'Définition du filtre (aucun)
    .Flags = &H4  'Option de la boite de dialogue
End With
 
If (GetSaveFileName(structSave)) Then
    EnregistrerUnFichier = Mid$(structSave.lpstrFile, 1, InStr(1, structSave.lpstrFile, vbNullChar) - 1)
End If
 
End Function

Et le lien pour la macro :

Code :

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

1
2
3
4
5
6
 
Sub essai()
 
MsgBox EnregistrerUnFichier(Me.hwnd, "Enregistrer sous", "Test.msg", "C:\")
 
End Sub

Quand je l'exécute, il me met une erreur au niveau du "Me.hwnd" ==> "utilisation incorrect du mot clé Me"

Pouvez-vous m'aider ?

[cafeine]

Hello,

essaie

Code :

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

EnregistrerUnFichier(0, "Enregistrer sous", "Test.msg", "C:\")

[megapacman]

dans outlook , tool /vba editor

copy & paste 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
 
 
Sub Save_Doc_Attachment()
 
    'Declaration
    Dim myItems, myItem, myAttachments, myAttachment As Object
    Dim myOrt As String
    Dim myOlApp As New Outlook.Application
    Dim myOlExp As Outlook.Explorer
    Dim myOlSel As Outlook.Selection
 
    Dim extension As String
    Dim nameattach As String
    Dim mypath As String
 
    mypath = "D:\testout\"
 
    'Ask for destination folder
    myOrt = InputBox("Destination", "Save Attachments", mypath)
 
    On Error Resume Next
 
    'work on selected items
    Set myOlExp = myOlApp.ActiveExplorer
    Set myOlSel = myOlExp.Selection
 
    'for all items do...
    For Each myItem In myOlSel
 
    Debug.Print myItem
 
        'point on attachments
        Set myAttachments = myItem.Attachments
 
        'if there are some...
        If myAttachments.Count > 0 Then
 
        Debug.Print myAttachments.Count
 
            'for all attachments do...
            For i = 1 To myAttachments.Count
 
            Debug.Print i
 
                'save them to destination
                Debug.Print myAttachments(i)
 
                extension = Right(myAttachments(i), 3)
                Debug.Print extension
 
                If ((extension = "doc") Or (extension = "DOC")) Then
 
                myAttachments(i).SaveAsFile myOrt & _
                    myAttachments(i).DisplayName
 
                nameattach = nameattach + myAttachments(i) & vbLf
                Debug.Print nameattach
 
                End If
 
            Next i
 
 
        End If
 
    Next
 
    MsgBox (nameattach & " is/are saved ")
 
    'free variables
    Set myItems = Nothing
    Set myItem = Nothing
    Set myAttachments = Nothing
    Set myAttachment = Nothing
    Set myOlApp = Nothing
    Set myOlExp = Nothing
    Set myOlSel = Nothing
 
End Sub

essaie de t'imspiré de ca , cette macro ne sauvegarde les docs dans un email,


l'email doit etre ouvert et tu lances ta macro avec un bouton sur ton mail


en fait myAttachments(i) sont tes pieces jointes


et myAttachments(i).SaveAsFile myOrt & _
myAttachments(i).DisplayName

sert a sauvegarde dans le chemin que ta donné (myort)

[wanou44]

Hello,

essaie

Code :

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

EnregistrerUnFichier(0, "Enregistrer sous", "Test.msg", "C:\")

Ca résoud mon problème d'erreur mais ça ne fonctionne toujours pas.

J'arrive à avoir la boite de dialogue "enregistrer sous", je fait OK là où je veux l'enregistrer.
J'ai eu une popup qui s'affiche avec le chemin de mon enregistrement mais quand je regarde sur mon disque, je n'ai rien du tout d'enregistré.

[SfJ5Rpw8]

ce code ne permet pas d'enregistrer un fichier mais seulement d'obtenir un nom de fichier qu'on peu ensuite utilisé..pour l'enregistrement...!

que désirez vous mettre dans ce fichier ..?

[wanou44]

essaie de t'imspiré de ca , cette macro ne sauvegarde les docs dans un email,


l'email doit etre ouvert et tu lances ta macro avec un bouton sur ton mail


en fait myAttachments(i) sont tes pieces jointes


et myAttachments(i).SaveAsFile myOrt & _
myAttachments(i).DisplayName

sert a sauvegarde dans le chemin que ta donné (myort)

Je n'arrive pas trop à comprendre comment faire.
J'ai essayé sans rien changer et ça m'affiche une boite de dialogue personnalisée mais moi je voudrais le boite de dialogue "Enregistrer sous" directement avec des paramètres personnalisés (extension, chemin par défaut, ...).

J'ai fait une macro à ma sauce pour afficher la bonne boite de dialogue mais ça ne fonctionne pas. Pourtant la macro provient de l'aide VBA d'Outlook.

Code :

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

1
2
3
4
5
6
7
Sub essai()
 
Dim fs As FileDialog
Set fd = Application.FileDialog(msoFileDialogSaveAs)
fd.Show
 
End Sub

[wanou44]

ce code ne permet pas d'enregistrer un fichier mais seulement d'obtenir un nom de fichier qu'on peu ensuite utilisé..pour l'enregistrement...!

que désirez vous mettre dans ce fichier ..?

Je veux pouvoir afficher la boite de dialogue "Enregistrer sous " avec des paramètres personnalisés.
Je sélectionne un message dans mon boite de réception sans forcément l'ouvrir et quand je clique sur le bouton lié à ma macro, la boite de dialogue s'affiche.

Et quand je clique sur OK, le message s'enregistre en .msg

[cafeine]

Ok,
alors ça marche comme ça

Code :

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

1
2
3
4
5
Dim strPath as String
strPath = EnregistrerUnFichier(0, "Enregistrer sous", "Test.msg", "C:\")
If Len(strPath) > 0 Then
   myAttachments(i).SaveAsFile strPath
End If

[wanou44]

Ok,
alors ça marche comme ça

Code :

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

1
2
3
4
5
Dim strPath as String
strPath = EnregistrerUnFichier(0, "Enregistrer sous", "Test.msg", "C:\")
If Len(strPath) > 0 Then
   myAttachments(i).SaveAsFile strPath
End If

Je n'y arrive pas.
Y a-t-il des modifications à faire dans le code que tu m'as passé ?

[cafeine]

Oui, il faut que tu adaptes ce code pour désigner un MailItem (objet mail) ...

ex :

Code :

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

1
2
3
4
5
set mail = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items(1)
For Each i=1 In Mail.Attachments.count
  Mail.Attachments(i).SaveAsFile EnregistrerUnFichier(0, _
         "Enregistrer sous", "Test.msg", "C:\")
Next i

[wanou44]

Oui, il faut que tu adaptes ce code pour désigner un MailItem (objet mail) ...

ex :

Code :

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

1
2
3
4
5
set mail = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items(1)
For Each i=1 In Mail.Attachments.count
  Mail.Attachments(i).SaveAsFile EnregistrerUnFichier(0, _
         "Enregistrer sous", "Test.msg", "C:\")
Next i

Je n'y arrive toujours pas.
Il me met "Incompatibilité de type".

[cafeine]

oops je me suis mélangé ...

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Machin()
 
Set mail = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items(1)
if Mail.attachments.count > 0 Then
   For i = 1 To mail.Attachments.Count
     mail.Attachments(i).SaveAsFile EnregistrerUnFichier(0, _
            "Enregistrer sous", "Test.msg", "C:\")
   Next i
else
   msgbox "Pas de piece jointe pour ce mail !"
end if
 
End Sub

[wanou44]

oops je me suis mélangé ...

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Machin()
 
Set mail = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items(1)
if Mail.attachments.count > 0 Then
   For i = 1 To mail.Attachments.Count
     mail.Attachments(i).SaveAsFile EnregistrerUnFichier(0, _
            "Enregistrer sous", "Test.msg", "C:\")
   Next i
else
   msgbox "Pas de piece jointe pour ce mail !"
end if
 
End Sub

Ca ne fonctionne toujours pas.
Que je sélectionne un message sans pièce jointe ou avec pièce jointe, il me renvoit toujours le message "Pas de pièce jointe pour ce mail !".

D'après ce que je comprends cette macro enregistre les pièces jointes d'un mail mais moi, j'aimerais enregistrer le mail entier sous forme msg.

[cafeine]

ok alors beaucoup plus simple :

permet d'enregistrer les mails sélectionnés !

Code :

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

1
2
3
4
5
6
set explo= Application.ActiveExplorer
set mails = explo.selection
For i = 1 to Mails.count
  mails(i).SaveAs EnregistrerUnFichier(0, _
            "Enregistrer sous", "Test.msg", "C:\")
Next i

[wanou44]

ok alors beaucoup plus simple :

permet d'enregistrer les mails sélectionnés !

Code :

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

1
2
3
4
5
6
set explo= Application.ActiveExplorer
set mails = explo.selection
For i = 1 to Mails.count
  mails(i).SaveAs EnregistrerUnFichier(0, _
            "Enregistrer sous", "Test.msg", "C:\")
Next i

Merci ça fonctionne impec et les pièce jointes restent attachées.
Comment je pourrais modifier cette macro, pour que le nom par défaut du fichier enregistré soit le nom du mail ?

Remplacer "Test.msg" par une variable & ".msg" ==> comment dire à la variable de prendre le sujet du mail ?

[wanou44]

Voilà j'ai essayé de modifier le code pour afficher le sujet comme nom d'enregistrement.
La variable que je définis prend bien le sujet du mail mais par contre, il ne veut pas se mettre dans la boite de dialogue. Il me renvoit toujours une erreur.

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
Dim NameFile As String
 
Set explo = Application.ActiveExplorer
Set mails = explo.Selection
 
For i = 1 To mails.Count
  NameFile = mails.Item(i)
  MsgBox NameFile
  mails(i).SaveAs EnregistrerUnFichier(0, _
            "Enregistrer sous", NameFile, "P:\")
Next i
 
i = i - 1
 
MsgBox "Nombre de messages enregistrés : " & i
 
End Sub

[cafeine]

dans ce cas ...

Code :

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

1
2
3
4
5
6
set explo= Application.ActiveExplorer
set mails = explo.selection
For i = 1 to Mails.count
  mails(i).SaveAs EnregistrerUnFichier(0, _
            "Enregistrer sous", Mail(i).subject & ".msg", "C:\")
Next i

[wanou44]

dans ce cas ...

Code :

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

1
2
3
4
5
6
set explo= Application.ActiveExplorer
set mails = explo.selection
For i = 1 to Mails.count
  mails(i).SaveAs EnregistrerUnFichier(0, _
            "Enregistrer sous", Mail(i).subject & ".msg", "C:\")
Next i

Il me met toujours la même erreur :
"Argument ou appel de procédure incorrect"