Macro sauvergarde d'un .msg dans un répertoire du disque choisi par l'utilisateur

Version imprimable

13/08/2019, 14h03
Fredjo71

Macro sauvergarde d'un .msg dans un répertoire du disque choisi par l'utilisateur
Bonjour à tous,
Bonjour à @Oliv- qui semble le gourou de ce sous-répertoire :D

J'ai besoin de vos lumières pour la création d'une macro qui va nous aider dans l'archivage de nos mails sur notre serveur, donc, un fichier .msg qui sera stocké sur le serveur "fichiers".

[historique]
La problématique à la base est que dans une boite mail partagée par plusieurs utilisateurs, nous avions créé +300 sous répertoires (un pour chaque client).. et que depuis quelques semaines, la synchronisation ne fonctionne plus bien, et qu'il y a parfois des doubles traitements... et ça énerve (à juste titre) mes collègues :mrgreen:

Après plusieurs recherche sur le oueb, j'ai pu constaté que plusieurs utilisateurs étaient dans le cas, et que la cause semblait systématique --> les nombreux sous-dossiers.
J'ai eu un (super!!) contact avec la hotline de Microsoft365 mais ils n'ont pu rien faire... et un consultant de mes amis m'a dit qu'effectivement c'était un soucis récurent dans 365.. de là à créer notre propre serveur exchange.. j'ai pas trop envie :aie:

[besoins]
- la macro doit pouvoir s'exécuter de la liste des mails sur base du mail exécuté ou aussi dans le mail ouvert (je suppose qu'il suffit que je personnalise le ruban ou quelque chose du style)
- une fenêtre popup permet à l'utilisateur de choisir le sous_dossier en tapant le numéro de son client.. C'est important pour la rapidité de l'exécution que l'utilisateur n'aie pas à chercher manuellement dans le répertoire. Ceci permettra un classement dans un répertoire comme ceci :
  https://i.ibb.co/34DjrZP/mails.jpg
- le fichier sera daté idéalement de la date de réception du mail (et pas du transfert), j'ai vu que c'était possible en cherchant (longtemps!) dans le forum
Un énorme merci d'avance pour vos suggestions de code.
J'ai vraiment cherché longtemps sur le forum avant de me lancer dans la discussion, mais je manque d'expérience et de connaissance en VBA pour utiliser/modifier tout ce que j'ai déjà pu trouver.
20/08/2019, 21h07
Fredjo71

Hé bé, faut croire que ma demande n'est pas si facile que ça ?

J'ai encore cherché depuis, et je me casse les dents sur le projet vraiment..

Si d'aventure quelqu'un pouvait m'aider, ça serait super sympa. :calim2:
30/08/2019, 14h43
Oliv-

Bonjour,
Voir cette discussion et les liens s'y trouvant.
https://www.developpez.net/forums/d2...-date-prefixe/
30/08/2019, 16h28
Fredjo71

Bonjour Oliv-

Merci pour votre réponse.. il me semble que j'avais déjà vu (et essayé) tout cela, je vais m'y replonger :ptdr:

Sur un plan plus pratico/pratique : je suis étonné du manque de publication concernant le VBA pour Outlook, que ce soit sur le web ou en éditions classique.. vous auriez des lectures à me soumettre (pour partir de rien, on s'entend).

Merci :)
30/08/2019, 16h55
Fredjo71

1 pièce(s) jointe(s)

Donc, oui, je me souviens maintenant, j'étais bien parvenu à ce résultat (parfait !) de votre discussion avec le gringo. Donc, déjà merci pour ça !

Il me manque cependant une (grosse) option, c'est la possibilité, via un 'userform' de pouvoir stocker le .msg dans un répertoire déjà créé sur notre serveur fichier qui serait déterminé par le numéro du dossier client.
Lors du lancement de la macro, l'utilisateur encode le numéro de dossier (4 digits) et le mail se sauve dans le dossier correspondant.

La structure du serveur fichier est :

Pièce jointe 500412

Bonjour,
Pour trouver le Dossier voici une fonction qui devrait fonctionner

Code:

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
Sub ChercheDossier()
    Dim numerodedossier As String
    numerodedossier = "2019"
    MsgBox TrouverFolderInFolder("c:\TEMP\PRINTtemp\", True, numerodedossier)
 
    Stop
End Sub
 
 
Function TrouverFolderInFolder(strFolderName As String, bIncludeSubfolders As Boolean, partname As String) As Variant
    Static Fso As Object    'FileSystemObject
    Dim oSourceFolder As Object    'Scripting.Folder
    Dim oSubFolder As Object    'Scripting.Folder
    Dim oFile As Object    'Scripting.FILE
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set oSourceFolder = Fso.getfolder(strFolderName)
 
 
    For Each oSubFolder In oSourceFolder.SubFolders
        '' On peut mettre ici un traitement spécifique pour les dossiers
        If StrComp(Left(oSubFolder.Name, 4), partname, vbTextCompare) = 0 Then
            TrouverFolderInFolder = oSubFolder.path
            Exit Function
        End If
    Next oSubFolder
 
    If bIncludeSubfolders Then
        For Each oSubFolder In oSourceFolder.SubFolders
            TrouverFolderInFolder = TrouverFolderInFolder(oSubFolder.path, True, partname)
            If TrouverFolderInFolder <> "" Then Exit Function
        Next oSubFolder
    End If
 
End Function

03/09/2019, 21h51
Fredjo71

Je commence à y piger quelque chose..
Je dois maintenant si je comprends bien, créer un "form" pour que l'utilisateur puisse saisir le numéro de dossier..

J'essaie.
Merci Oliv-
04/09/2019, 09h31
Fredjo71

Bon, j'ai vraiment des failles dans le cerveau, je n'arrive à rien :weird:

Lorsque la macro se lance, il faut que l'utilisateur puisse saisir un numéro de dossier, et que la macro range le .msg dans le répertoire adéquat..
Si quelqu'un est preneur de me réaliser ceci, je pense que je peux financer le travail ;)