Discussion :

[QuestVba]

Bonjour, Forum,

J'ai un répertoire qui contient plusieurs mails enregistrés au format .msg.

Est-il possible dé récupérer une partie du nom (ça, c'est facile avec une boucle et un split) et mettre cette partie dans l'objet du mail ?

Si vous avez une idée, je suis preneur.

[QuestVba]

J'approche

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
Sub bla_OK()
Dim objOL As Object
Dim Msg As Object
Set objOL = CreateObject("Outlook.Application")
inPath = "C:\Tests"
thisFile = Dir(inPath & "\*.msg")
'Set Msg = objOL.CreateItemFromTemplate(thisFile)
Set Msg = objOL.Session.OpenSharedItem(inPath & "\" & thisFile)
' now use msg to get at the email parts
MsgBox Msg.Subject
Msg.Subject = "Coucou"
Msg.Save
Set objOL = Nothing
Set Msg = Nothing
End Sub

[QuestVba]

Voici ce que j'ai fait et c'est vraiment pas très propre mais cela fonctionne.

Code :

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

1
2
3
4
Sub appel()
    MYPATH_IS = "I:\Bruxelles-Brussel\Maildossiers\__Tests"
    RecupTypeImage (MYPATH_IS)
End Sub

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
Sub RecupTypeImage(rPath As String)
Dim oFSO As Scripting.FileSystemObject
Dim rFld As Scripting.Folder
Dim cFld As Scripting.Folder
Dim oFl As File
Dim objOL As Object
Dim Msg As Object
Dim line As Integer
 
Set oFSO = New Scripting.FileSystemObject
Set rFld = oFSO.GetFolder(MYPATH_IS)
 
For Each cFld In rFld.SubFolders
    RecupTypeImage (cFld.Path)
Next cFld
 
For Each oFl In rFld.Files
    XX = oFl.Name
    Debug.Print XX
    If Right(oFl.Name, 3) = "msg" Then
        bla_OK (XX)
    Else
        Kill MYPATH_IS & "\" & XX
    End If
Next oFl
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub bla_OK(FileChoose)
Dim objOL As Object
Dim Msg As Object
 
Set objOL = CreateObject("Outlook.Application")
inPath = MYPATH_IS
thisFile = Dir(inPath & "\" & FileChoose) 
Set Msg = objOL.Session.OpenSharedItem(inPath & "\" & thisFile)
Msg.Subject = Mid(thisFile, 1, 7)
Msg.Save
Set objOL = Nothing
Set Msg = Nothing
End Sub

[Oliv-]

Bonsoir,
C'est pas mal, comme cela ce sera mieux

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
 
 
Dim objOL
Dim oFSO As Scripting.FileSystemObject
 
 
Sub appel()
    MYPATH_IS = "I:\Bruxelles-Brussel\Maildossiers\__Tests"
 
 Set oFSO = New Scripting.FileSystemObject
Set objOL = CreateObject("Outlook.Application")
 
    RecupTypeImage (MYPATH_IS)
End Sub
 
 
 
Sub RecupTypeImage(rPath As String)
 
Dim rFld As Scripting.Folder
Dim cFld As Scripting.Folder
Dim oFl As File
Dim objOL As Object
Dim Msg As Object
Dim line As Integer
 
Set rFld = oFSO.GetFolder(MYPATH_IS)
 
For Each cFld In rFld.SubFolders
    RecupTypeImage (cFld.Path)
Next cFld
 
For Each oFl In rFld.Files
    XX = oFl.Name
    Debug.Print XX
    If Right(oFl.Name, 3) = "msg" Then
        bla_OK (XX)
    Else
        Kill MYPATH_IS & "\" & XX
    End If
Next oFl
End Sub
 
 
Sub bla_OK(FileChoose)
Dim Msg As Object
 
inPath = MYPATH_IS
thisFile = Dir(inPath & "\" & FileChoose) 
Set Msg = objOL.Session.OpenSharedItem(inPath & "\" & thisFile)
Msg.Subject = Mid(thisFile, 1, 7)
Msg.Save
Set Msg = Nothing
End Sub

tu pourrais envoyer directement à bla_ok l'objet oFl

[QuestVba]

Merci, Oliv- , pour cette proposition d'amélioration ! C'est super cool.
Effectivement, maintenant que le code fonctionne, il faudra que je le diminue et qu'il se résume au minimum pour qu'il soit aussi efficace à la (re)lecture.

[Oliv-]

C'est surtout une question de performance et de mémoire