Discussion :

[et1000lio]

Bonjour à tous,

Je viens de migrer sur la version 2016 pour le pack Microsoft.
J'utilisais pour les versions précédente la macro de 'By Oliv' juillet 2007 pour OUTLOOK 2003 qui fonctionnait parfaitement (pour enregistrer des MAILS spécifique sur un serveur.

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
Sub sav_mail_as_msg(Optional objCurrentMessage As Object)
'By Oliv' juillet 2007 pour OUTLOOK 2003
 
    If objCurrentMessage Is Nothing Then Set objCurrentMessage = ActiveInspector.CurrentItem
Dim MSG
MSG = InputBox("Mentionnez la référence du mail : ")
    'Ici on construit le nom du fichier qui sera créé
    NomExport = MSG 'objCurrentMessage.Subject & objCurrentMessage.CreationTime
 
    'Ici on défini le répertoire où l'enregistrer
    repertoire = "ADRESSE DU SERVEUR " 'Par principe de confidentialité je ne peux le mentionner mais fonctionne parfaitement avec une adresse IP
    'repertoire = BrowseForFolder("Choisissez la destination", SDossier(5, 0)) & "\"
 
    'Ici on supprime les caractères non autorisé dans les noms de fichiers
    PathNomExport = repertoire & Left(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
    NomExport, "\", ""), "/", ""), ":", ""), "*", ""), "?", ""), "<", ""), ">", ""), "|", ""), "$", ""), """", ""), vbTab, ""), Chr(7), ""), 160)
 
    'Ici on vérifie que le fichier n'existe pas déjà sinon il serait écrasé
    n = 1
    MemPath = PathNomExport
    While Dir(PathNomExport) <> ""
        MsgBox "Le fichier " & vbCr & PathNomExport & vbCr & "existe déjà", vbInformation
        PathNomExport = Left(MemPath, Len(MemPath) - 4) & "(" & n & ")" & ".msg"
        n = n + 1
 
    Wend
    objCurrentMessage.SaveAs PathNomExport, OlSaveAsType.olMSG
 
End Sub

Hors depuis au lancement de la programmation il m'affiche le message suivant :
Erreur d'exécution '91' : Variable objet ou variable de bloc With non définie
et me surligne (après débogage) le texte suivant : Set objCurrentMessage = ActiveInspector.CurrentItem

Y-a-t-il une solution ? j'ai aussi chercher la Outils Références .... mais rien.

Merci pour vos réponses à venir.
et1000lio

[Oliv-]

L'email est il bien ouvert (en dehors du mode inline ?)

Essaye en utilisant cette fonction

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application
 
    Set objApp = Application
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
        Case "Explorer"
            Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
    End Select
 
    Set objApp = Nothing
End Function

là (ligne 4)

Code :

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

 If objCurrentMessage Is Nothing Then Set objCurrentMessage = GetCurrentItem

[et1000lio]

BRAVO et Merci Oliv-

Oui le mail à enregistrer est OUVERT, ça fonctionne parfaitement maintenant. Encore merci car tu m'enlèves une épine du pied car on s'habitue vite au tâche qui nous font gagner du temps.

Ce serait bien d'ajouter ce bout de code à http://outlook.developpez.com/faq/?page=VBA à la rubrique Comment enregistrer mes messages sur mon disque dur ?

Emile

[SC029]

Salut,

J'avais il y a quelques temps mis en place une règle Outlook dont l'une des actions lançait un script de ce genre afin d'enregistrer le mail sur un serveur.
Depuis peu, les règles outlook n'offrent plus la possibilité de lancer des scripts.
Quelles solutions de contournement avez-vous adoptées pour palier à cette évolution de Outlook ?